home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / ATVSRC.RAR / TEXTVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  2000-08-15  |  10KB  |  407 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {       Virtual Pascal v2.1                             }
  10. {       Copyright (C) 1996-2000 vpascal.com             }
  11. {                                                       }
  12. {*******************************************************}
  13.  
  14. unit TextView;
  15.  
  16. {$X+,I-,S-,Cdecl-,Use32+}
  17.  
  18. interface
  19.  
  20. uses Objects, Drivers, Views, Dos;
  21.  
  22. type
  23.  
  24.   { TTextDevice }
  25.  
  26.   PTextDevice = ^TTextDevice;
  27.   TTextDevice = object(TScroller)
  28.     function StrRead(var S: TextBuf): Byte; virtual;
  29.     procedure StrWrite(var S: TextBuf; Count: Byte); virtual;
  30.   end;
  31.  
  32.   { TTerminal }
  33.  
  34.   PTerminalBuffer = ^TTerminalBuffer;
  35.   TTerminalBuffer = array[0..65534] of Char;
  36.  
  37.   PTerminal = ^TTerminal;
  38.   TTerminal = object(TTextDevice)
  39.     BufSize: Word;
  40.     Buffer: PTerminalBuffer;
  41.     QueFront, QueBack: Word;
  42.     constructor Init(var Bounds:TRect; AHScrollBar, AVScrollBar: PScrollBar;
  43.       ABufSize: Word);
  44.     destructor Done; virtual;
  45.     procedure BufDec(var Val: Word);
  46.     procedure BufInc(var Val: Word);
  47.     function CalcWidth: Integer;
  48.     function CanInsert(Amount: Word): Boolean;
  49.     procedure Draw; virtual;
  50.     function NextLine(Pos:Word): Word;
  51.     function PrevLines(Pos:Word; Lines: Word): Word;
  52.     function StrRead(var S: TextBuf): Byte; virtual;
  53.     procedure StrWrite(var S: TextBuf; Count: Byte); virtual;
  54.     function QueEmpty: Boolean;
  55.   end;
  56.  
  57. procedure AssignDevice(var T: Text; Screen: PTextDevice);
  58.  
  59. implementation
  60.  
  61. { TTextDevice }
  62.  
  63. function TTextDevice.StrRead(var S: TextBuf): Byte;
  64. begin
  65.   StrRead := 0;
  66. end;
  67.  
  68. procedure TTextDevice.StrWrite(var S: TextBuf; Count: Byte);
  69. begin
  70. end;
  71.  
  72. { TTerminal }
  73.  
  74. constructor TTerminal.Init(var Bounds:TRect; AHScrollBar,
  75.   AVScrollBar: PScrollBar; ABufSize: Word);
  76. begin
  77.   TTextDevice.Init(Bounds, AHScrollBar, AVScrollBar);
  78.   GrowMode := gfGrowHiX + gfGrowHiY;
  79.   BufSize := ABufSize;
  80.   if BufSize > 65520 then BufSize := 65520;
  81.   GetMem(Buffer, BufSize);
  82.   QueFront := 0;
  83.   QueBack := 0;
  84.   SetLimit(0,1);
  85.   SetCursor(0,0);
  86.   ShowCursor;
  87. end;
  88.  
  89. destructor TTerminal.Done;
  90. begin
  91.   FreeMem(Buffer, BufSize);
  92.   TTextDevice.Done;
  93. end;
  94.  
  95. procedure TTerminal.BufDec(var Val: Word);
  96. begin
  97.   if Val = 0 then Val := BufSize - 1
  98.   else Dec(Val);
  99. end;
  100.  
  101. procedure TTerminal.BufInc(var Val: Word);
  102. begin
  103.   Inc(Val);
  104.   if Val >= BufSize then Val := 0;
  105. end;
  106.  
  107. function TTerminal.CalcWidth: Integer;
  108. var
  109.   I, Len, Width: Integer;
  110.   CurPos, EndPos: Integer;
  111. begin
  112.   Width := 0;
  113.   CurPos := QueBack;
  114.   for I := 1 to Limit.Y do
  115.   begin
  116.     EndPos := NextLine(CurPos);
  117.     if EndPos >= CurPos then
  118.       Len := EndPos - CurPos else
  119.       Len := BufSize - CurPos + EndPos;
  120.     if Buffer^[EndPos-1] = #10 then
  121.       Dec(Len) else
  122.       Inc(Len);
  123.     if Len > Width then
  124.       Width := Len;
  125.     CurPos := EndPos;
  126.   end;
  127.   CalcWidth := Width;
  128. end;
  129.  
  130. function TTerminal.CanInsert(Amount: Word): Boolean;
  131. var
  132.   T: Longint;
  133. begin
  134.   if QueFront < QueBack then T := QueFront + Amount
  135.   else T := LongInt(QueFront) - LongInt(BufSize) + Amount;
  136.   CanInsert := QueBack > T;
  137. end;
  138.  
  139. procedure TTerminal.Draw;
  140. var
  141.   I: Integer;
  142.   BegLine, EndLine: Word;
  143.   S: String;
  144.   T: Longint;
  145.   BottomLine: Word;
  146. begin
  147.   BottomLine := Size.Y + Delta.Y;
  148.   if Limit.Y > BottomLine then
  149.   begin
  150.     EndLine := PrevLines(QueFront, Limit.Y-BottomLine);
  151.     BufDec(EndLine);
  152.   end
  153.   else EndLine := QueFront;
  154.   if Limit.Y-1 >= Size.Y then I := Size.Y-1
  155.   else
  156.   begin
  157.     for I := Limit.Y to Size.Y-1 do
  158.       WriteChar(0, I, ' ', 1, Size.X);
  159.     I := Limit.Y-1;
  160.   end;
  161.   for I := I downto 0 do
  162.   begin
  163.     BegLine := PrevLines(EndLine,1);
  164.     if EndLine >= BegLine then
  165.     begin
  166.       T := EndLine - BegLine;
  167.       Move(Buffer^[BegLine], S[1], T);
  168.       S[0] := Char(T);
  169.     end
  170.     else
  171.     begin
  172.       T := BufSize - BegLine;
  173.       Move(Buffer^[BegLine], S[1], T);
  174.       Move(Buffer^, S[T+1], EndLine);
  175.       S[0] := Char(T + EndLine);
  176.     end;
  177.     if Delta.X >= Length(S) then S := ''
  178.     else S := Copy(S, Delta.X+1, 255);
  179.     WriteStr(0, I, S, 1);
  180.     WriteChar(Length(S), I, ' ', 1, Size.X);
  181.     EndLine := BegLine;
  182.     BufDec(EndLine);
  183.   end;
  184. end;
  185.  
  186. function TTerminal.NextLine(Pos:Word): Word;
  187. begin
  188.   if Pos <> QueFront then
  189.   begin
  190.     while (Buffer^[Pos] <> #10) and (Pos <> QueFront) do
  191.       BufInc(Pos);
  192.     if Pos <> QueFront then BufInc(Pos);
  193.   end;
  194.   NextLine := Pos;
  195. end;
  196.  
  197. procedure DecEDi; assembler; {$USES None} {$FRAME-}
  198. asm
  199.                 cmp     edi,[esi].TTerminal.Buffer
  200.                 ja      @@1
  201.                 add     edi,[esi].TTerminal.BufSize
  202.               @@1:
  203.                 dec     edi
  204. end;
  205.  
  206. procedure IncEDi; assembler; {$USES None} {$FRAME-}
  207. asm
  208.                 inc     edi
  209.                 mov     eax,[esi].TTerminal.Buffer
  210.                 add     eax,[esi].TTerminal.BufSize
  211.                 cmp     edi,eax
  212.                 jb      @@1
  213.                 mov     edi,[esi].TTerminal.Buffer
  214.               @@1:
  215. end;
  216.  
  217. {$USES esi,edi} {$FRAME-}
  218.  
  219. function TTerminal.PrevLines(Pos:Word; Lines:Word): Word; assembler;
  220. const
  221.   LineSeparator = #10;
  222. asm
  223.                 mov     esi,Self
  224.                 mov     edi,[esi].TTerminal.Buffer
  225.                 add     edi,Pos
  226.               @@1:
  227.                 mov     ecx,Lines
  228.                 jecxz   @@6
  229.                 mov     eax,[esi].TTerminal.QueBack
  230.                 add     eax,[esi].TTerminal.Buffer
  231.                 cmp     edi,eax
  232.                 je      @@7
  233.                 Call    DecEDI
  234.               @@2:
  235.                 mov     eax,[esi].TTerminal.QueBack
  236.                 add     eax,[esi].TTerminal.Buffer
  237.                 cmp     edi,eax
  238.                 ja      @@3
  239.                 mov     ecx,edi
  240.                 sub     ecx,[esi].TTerminal.Buffer
  241.                 jmp     @@4
  242.               @@3:
  243.                 mov     ecx,edi
  244.                 sub     ecx,eax
  245.               @@4:
  246.                 mov     al,LineSeparator
  247.                 inc     ecx
  248.                 std
  249.                 repne   scasb
  250.                 je      @@5
  251.                 mov     eax,edi
  252.                 sub     eax,[esi].TTerminal.Buffer
  253.                 inc     eax
  254.                 cmp     eax,[esi].TTerminal.QueBack
  255.                 je      @@8
  256.                 mov     edi,[esi].TTerminal.Buffer
  257.                 add     edi,[esi].TTerminal.BufSize
  258.                 dec     edi
  259.                 jmp     @@2
  260.               @@5:
  261.                 dec     Lines
  262.                 jnz     @@2
  263.               @@6:
  264.                 Call    IncEDI
  265.                 Call    IncEDI
  266.                 mov     eax,edi
  267.               @@7:
  268.                 sub     eax,[esi].TTerminal.Buffer
  269.               @@8:
  270. end;
  271.  
  272. function TTerminal.StrRead(var S: TextBuf): Byte;
  273. begin
  274.   StrRead := 0;
  275. end;
  276.  
  277. procedure TTerminal.StrWrite(var S: TextBuf; Count: Byte);
  278. var
  279.   I, J: Word;
  280.   ScreenLines: Word;
  281. begin
  282.   if Count = 0 then
  283.     Exit else
  284.     if Count >= BufSize then
  285.       Count := BufSize-1;
  286.   ScreenLines := Limit.Y;
  287.   J := 0;
  288.   for I := 0 to Count-1 do
  289.     case S[I] of
  290.       #13: Dec(Count)
  291.       else
  292.       begin
  293.         if S[I] = #10 then Inc(ScreenLines);
  294.         S[J] := S[I];
  295.         Inc(J);
  296.       end;
  297.     end;
  298.  
  299.   while not CanInsert(Count) do
  300.   begin
  301.     QueBack := NextLine(QueBack);
  302.     Dec(ScreenLines);
  303.   end;
  304.  
  305.   if LongInt(QueFront) + Count >= BufSize then
  306.   begin
  307.     I := BufSize - QueFront;
  308.     Move(S,Buffer^[QueFront], I);
  309.     Move(S[I],Buffer^, Count - I);
  310.     QueFront := Count - I;
  311.   end
  312.   else
  313.   begin
  314.     Move(S,Buffer^[QueFront],Count);
  315.     Inc(QueFront,Count);
  316.   end;
  317.   SetLimit(CalcWidth,ScreenLines);
  318.   ScrollTo(0, ScreenLines+1);
  319.   I := PrevLines(QueFront,1);
  320.   if I <= QueFront then I := QueFront - I
  321.   else I := BufSize - (I - QueFront);
  322.   SetCursor(I, ScreenLines-Delta.Y-1);
  323.   DrawView;
  324. end;
  325.  
  326. function TTerminal.QueEmpty: Boolean;
  327. begin
  328.   QueEmpty := QueBack = QueFront;
  329. end;
  330.  
  331. { Window Text Device Driver }
  332.  
  333. type
  334.   WindowData = record
  335.     Screen: PTextDevice;
  336.     Filler: array [1..28] of Char;
  337.   end;
  338.  
  339. function WindowWrite(var F: TextRec): Integer; far;
  340. begin
  341.   with F do
  342.   begin
  343.     WindowData(UserData).Screen^.StrWrite(BufPtr^, BufPos);
  344.     BufPos := 0;
  345.   end;
  346.   WindowWrite := 0;
  347. end;
  348.  
  349. function WindowRead(var F: TextRec): Integer; far;
  350. begin
  351.   with F do
  352.   begin
  353.     BufPos := 0;
  354.     BufEnd := WindowData(F.UserData).Screen^.StrRead(BufPtr^);
  355.   end;
  356.   WindowRead := 0;
  357. end;
  358.  
  359. function WindowFlush(var F: TextRec): Integer; far;
  360. begin
  361.   F.BufPos := 0;
  362.   F.BufEnd := 0;
  363.   WindowFlush := 0;
  364. end;
  365.  
  366. function WindowOpen(var F: TextRec): Integer; far;
  367. begin
  368.   with F do
  369.   begin
  370.     if Mode = fmInput then
  371.     begin
  372.       InOutFunc := @WindowRead;
  373.       FlushFunc := @WindowFlush;
  374.     end
  375.     else
  376.     begin
  377.       InOutFunc := @WindowWrite;
  378.       FlushFunc := @WindowWrite;
  379.     end;
  380.     WindowOpen := 0;
  381.   end;
  382. end;
  383.  
  384. function WindowIgnore(var F: TextRec): Integer; far;
  385. begin
  386.   WindowIgnore := 0;
  387. end;
  388.  
  389. var
  390.   Buffer: TextBuf;
  391.  
  392. procedure AssignDevice(var T: Text; Screen: PTextDevice);
  393. begin
  394.   with TextRec(T) do
  395.   begin
  396.     Handle := $FFFFFFFF;
  397.     Mode := fmClosed;
  398.     BufSize := SizeOf(Buffer);
  399.     BufPtr := @Buffer;
  400.     OpenFunc := @WindowOpen;
  401.     CloseFunc := @WindowIgnore;
  402.     WindowData(UserData).Screen:= Screen;
  403.   end;
  404. end;
  405.  
  406. end.
  407.