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