home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 22 / buffer / ubuffer.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-01-04  |  24.0 KB  |  808 lines
  1. (* ----------------------------------------------------- *)
  2. (*                    UBUFFER.PAS                        *)
  3. (*                                                       *)
  4. (* ■ Buffer: Bildet einen Buffer nach, der aus einem     *)
  5. (*   Zeilenarray besteht, Attribut für die Zeichen er-   *)
  6. (*   laubt. Buffer arbeitet nur im normalen Heap (nicht  *)
  7. (*   in Extended Memory o.ä.).                           *)
  8. (*                                                       *)
  9. (*            (c) 1991 by R.Reichert & toolbox           *)
  10. (* ----------------------------------------------------- *)
  11. UNIT UBuffer;
  12.  
  13. INTERFACE
  14.  
  15. USES UBase;
  16.  
  17. CONST
  18.   MaxMaxLines   = 16300;      { theoretische Maximalwerte }
  19.   MaxMaxColumns = 32766;
  20.   MinColumns    = 10;             { Mindest Anzahl Zeilen }
  21.  
  22.   {------ Fehler aus Buffer: -----------------------------}
  23.   BufOk         = 0;           { kein Fehler aufgetreten  }
  24.   BufInitErr    = 1;           { Fehler in Init           }
  25.   BufInsLineErr = 2;           { Fehler beim Einfügen     }
  26.   BufDelLineErr = 3;           { bzw Löschen einer Zeile  }
  27.   BufWriteStrErr= 4;           { beim Schreiben           }
  28.   BufCheckXYErr = 5;           { X und/oder Y ungültig    }
  29.   BufNoMem      = 6;           { kein Speicher mehr       }
  30.  
  31. TYPE
  32.   LineEndType= (WriteOver, CutEnd, CutPrevWord);
  33.   FormatTypes= (Left, Center, Right);
  34.  
  35.   OneLinePtr = ^OneLine;
  36.   OneLine    = ARRAY [0..MaxMaxColumns] OF WORD;
  37.  
  38.   DataBufferPtr  = ^DataBuffer;
  39.   DataBuffer  = ARRAY [0..MaxMaxLines] OF OneLinePtr;
  40.  
  41.   BufferPtr  = ^Buffer;
  42.   Buffer     = OBJECT (Base)
  43.  
  44.     MoveBufCur,                 { "Cursor" bewegen ?    }
  45.     KillLineRest,               { Zeilenrest löschen    }
  46.     KillWrite,                  { vor Schreiben löschen }
  47.     LineFeed : BOOLEAN;         { Zeilenvorschub ?      }
  48.     BufErrorL1,                 { Fehler-Nr Level 1     }
  49.     BufErrorL2,
  50.     BufCurX,                    { Cursor-X-Position     }
  51.     BufCurY,                    { Cursor-Y-Position     }
  52.     MaxColumns,                 { Max. Anzahl Spalten   }
  53.     Columns,                    { Anzahl Spalten        }
  54.     MaxLines,                   { Max. Anzahl Zeilen    }
  55.     Lines    : WORD;       { Tatsächliche Anzahl Zeilen }
  56.     FreeHeap : LONGINT;      { freizulassender Speicher }
  57.     Attr     : BYTE;            { Attribut              }
  58.     TextBuf  : DataBufferPtr;   { Puffer (-zeiger)      }
  59.     LineForm : FormatTypes;     { Art des Schreibens    }
  60.     LineEnd  : LineEndType;     { Zeilenend-Art         }
  61.     WordEndChars : STRING;     { Zeichen für Zeilenende }
  62.     InfoLine : OneLinePtr;     { Zeile 0 beim Speichern }
  63.  
  64.     CONSTRUCTOR Init
  65.       (MC, ML, BegLines : WORD; FrHeap : LONGINT);
  66.     {---------- Interne Methoden: ----------------------}
  67.     PROCEDURE ErrorHandling (Nr : WORD);         VIRTUAL;
  68.     PROCEDURE GetNewLine
  69.       (Attribut : BYTE; VAR NewLine : OneLine);  VIRTUAL;
  70.     PROCEDURE FormatLine (VAR Line : OneLine);   VIRTUAL;
  71.     FUNCTION GetCutPos
  72.       (Str : STRING; x : WORD) : WORD;           VIRTUAL;
  73.     FUNCTION GetLastWord
  74.       (str : STRING; x : WORD) : WORD;           VIRTUAL;
  75.     FUNCTION XYInBuf (x, y : WORD) : BOOLEAN;    VIRTUAL;
  76.     PROCEDURE SaveNewLine
  77.       (y : WORD; VAR Line : OneLine);            VIRTUAL;
  78.     PROCEDURE LoadLine
  79.       (y : WORD; VAR Line : OneLine);            VIRTUAL;
  80.     PROCEDURE KillLines (Num : WORD);            VIRTUAL;
  81.     PROCEDURE NewLines (Num : WORD);             VIRTUAL;
  82.     PROCEDURE WriteOneLine (str : STRING;
  83.                             x, y : WORD;
  84.                             VAR Line : OneLine); VIRTUAL;
  85.     {--------- Methoden für "Aussenwelt": --------------}
  86.     PROCEDURE SetMaxLines (NewML : INTEGER);     VIRTUAL;
  87.     PROCEDURE InsLines (y, No : WORD);           VIRTUAL;
  88.     PROCEDURE CopyLine (Source, Dest : WORD);    VIRTUAL;
  89.     PROCEDURE DelLines (y, No : WORD);           VIRTUAL;
  90.     PROCEDURE WriteStrXY
  91.       (x, y : WORD; Str : STRING);               VIRTUAL;
  92.     PROCEDURE WriteStr (Str : STRING);           VIRTUAL;
  93.     PROCEDURE ChangeColor
  94.       (x1, y1, x2, y2 : WORD;
  95.        NewCol, NewBackCol : BYTE);               VIRTUAL;
  96.     PROCEDURE SetColumns (Cols : WORD);          VIRTUAL;
  97.     PROCEDURE SetWriteColor (Col, Back : BYTE);  VIRTUAL;
  98.     PROCEDURE SetBufCursor (x, y : WORD);        VIRTUAL;
  99.     PROCEDURE SetMoveCursor (MC : BOOLEAN);      VIRTUAL;
  100.     PROCEDURE SetKillRest (KR : BOOLEAN);        VIRTUAL;
  101.     PROCEDURE SetKillWriting (KW : BOOLEAN);     VIRTUAL;
  102.     PROCEDURE SetLineFeed (LF : BOOLEAN);        VIRTUAL;
  103.     PROCEDURE SetAttr (NewAttr : BYTE);          VIRTUAL;
  104.     PROCEDURE SetLineForm (LF : FormatTypes);    VIRTUAL;
  105.     PROCEDURE SetLineEnding (LE : LineEndType);  VIRTUAL;
  106.     PROCEDURE SetWordEndChrs (WECs : STRING);    VIRTUAL;
  107.  
  108.     PROCEDURE GetBufXYColors
  109.       (x, y : WORD; VAR Col,BackCol : BYTE);     VIRTUAL;
  110.     FUNCTION Convert2Str (y : WORD) : STRING;    VIRTUAL;
  111.     FUNCTION GetLinePtr (y : WORD) : OneLinePtr; VIRTUAL;
  112.     FUNCTION GetLineLength (y : WORD) : WORD;    VIRTUAL;
  113.     FUNCTION GetBufXYAttr (x, y : WORD) : BYTE;  VIRTUAL;
  114.     FUNCTION GetMoveCursor : BOOLEAN;            VIRTUAL;
  115.     FUNCTION GetKillRest : BOOLEAN;              VIRTUAL;
  116.     FUNCTION GetKillWriting : BOOLEAN;           VIRTUAL;
  117.     FUNCTION GetLineFeed : BOOLEAN;              VIRTUAL;
  118.     FUNCTION GetErrorL1 : WORD;                  VIRTUAL;
  119.     FUNCTION GetErrorL2 : WORD;                  VIRTUAL;
  120.     FUNCTION GetX : WORD;                        VIRTUAL;
  121.     FUNCTION GetY : WORD;                        VIRTUAL;
  122.     FUNCTION GetColumns : WORD;                  VIRTUAL;
  123.     FUNCTION GetMaxColumns : WORD;               VIRTUAL;
  124.     FUNCTION GetLines : WORD;                    VIRTUAL;
  125.     FUNCTION GetMaxLines : WORD;                 VIRTUAL;
  126.     FUNCTION GetAttr : BYTE;                     VIRTUAL;
  127.     FUNCTION GetLineForm : FormatTypes;          VIRTUAL;
  128.     FUNCTION GetLineEnding : LineEndType;        VIRTUAL;
  129.     FUNCTION GetWordEndChars  : STRING;          VIRTUAL;
  130.     FUNCTION GetFreeHeap : WORD;                 VIRTUAL;
  131.  
  132.     DESTRUCTOR Done;                             VIRTUAL;
  133.   END;
  134.  
  135. CONST
  136.   CopyTL  = 1;  InsTL   = 2;  GetLLTL = 3;  SetMLTL = 4;
  137.   LPTL    = 5;  WrtStrTL= 6;  ConvTL  = 7;  TL      = 8;
  138.  
  139. VAR
  140.   TempLines : ARRAY [CopyTL..TL] OF OneLinePtr;
  141.   Time      : LONGINT ABSOLUTE $40:$6C;
  142.   i         : WORD;
  143.  
  144. IMPLEMENTATION
  145.  
  146. (* ----------------------------------------------------- *)
  147. (* Initialisiert Objekt. Parameter:                      *)
  148. (* MC: MaxColumns, verbindlich für die weitere Arbeit mit*)
  149. (*     dem Objekt !                                      *)
  150. (* ML: MaxLines, dito                                    *)
  151. (* BegLines: Soviele Zeilen werden zu Beginn schon als   *)
  152. (*           Leerzeilen angelegt.                        *)
  153. (* FrHeap: Freizulassender Heap, kann während Programm-  *)
  154. (*         ablauf geändert werden, sofern möglich        *)
  155. (* Die restlichen Variablen werden, sofern kein Fehler   *)
  156. (* bei der Speicherbelegung auftritt, mit Standardwerten *)
  157. (* belegt.                                               *)
  158. (* ----------------------------------------------------- *)
  159. CONSTRUCTOR Buffer.Init
  160.               (MC, ML, BegLines : WORD; FrHeap : LONGINT);
  161.   VAR NeedMem,
  162.       MemLimit,
  163.       i     : LONGINT;
  164.       Error : BOOLEAN;
  165. BEGIN
  166.   Error := FALSE;
  167.   {---------------- Parameter überprüfen -----------------}
  168.   IF (FrHeap >= 0) AND (FrHeap < MemAvail) THEN
  169.     FreeHeap := FrHeap
  170.   ELSE
  171.     Error := TRUE;
  172.   IF (MaxMaxColumns > MC) AND (MinColumns < MC) THEN
  173.     MaxColumns := MC
  174.   ELSE
  175.     Error := TRUE;
  176.   IF (MaxMaxLines > ML) AND (ML > 0) THEN
  177.     MaxLines := ML
  178.   ELSE
  179.     Error := TRUE;
  180.   {---------------------- Speicher belegen ---------------}
  181.   IF NOT Error THEN BEGIN
  182.     Columns := MaxColumns;
  183.     NeedMem := LONGINT (2 * Succ (MaxColumns)) *
  184.                LONGINT (Succ (TL + BegLines)) +
  185.                LONGINT (4 * Succ (MaxLines));
  186.     MemLimit := MemAvail - FreeHeap;
  187.     IF NeedMem < MemLimit THEN BEGIN
  188.       GetMem (TextBuf, 4 * Succ (MaxLines));
  189.       FOR i := CopyTL TO TL DO
  190.         GetMem (TempLines [i], 2 * Succ (MaxColumns));
  191.       GetMem (InfoLine, 2 * Succ (MaxColumns));
  192.       GetNewLine (0, InfoLine^);
  193.       FOR i := 1 TO MaxLines DO
  194.         TextBuf^[i] := NIL;
  195.       {------------------- Variablen setzen ------------}
  196.       MoveBufCur := TRUE;
  197.       KillLineRest := TRUE;     KillWrite  := TRUE;
  198.       LineFeed  := TRUE;
  199.       BufErrorL1:= BufOk;       BufErrorL2 := BufOk;
  200.       BufCurX   := 1;           BufCurY    := 1;
  201.       Lines     := BegLines;
  202.       Attr      := 7;
  203.       LineForm  := Left;        LineEnd    := WriteOver;
  204.       WordEndChars := ')+!?,.;:/-+ ';
  205.       {-------------------------------------------------
  206.        Speicher für "Startzeilen" belegen              }
  207.       IF Lines > MaxLines THEN
  208.         Lines := MaxLines;
  209.       IF Lines>0 THEN BEGIN
  210.         i := Lines; Lines := 0;
  211.         SetMaxLines (i);
  212.       END;
  213.     END ELSE
  214.       Error := TRUE;
  215.   END;
  216.   IF Error THEN BEGIN
  217.     Errorhandling (BufInitErr);
  218.     Fail;
  219.   END;
  220. END;
  221.  
  222. PROCEDURE Buffer.ErrorHandling (Nr : WORD);
  223. BEGIN
  224.   IF Nr=BufNoMem THEN
  225.     BufErrorL1 := Nr
  226.   ELSE
  227.     BufErrorL2 := Nr;
  228. END;
  229.  
  230. PROCEDURE Buffer.GetNewLine (Attribut : BYTE;
  231.                              VAR NewLine : OneLine);
  232.   VAR i : WORD;
  233. BEGIN
  234.   IF Attribut=0 THEN
  235.     FillChar (NewLine, Succ (MaxColumns*2), 0)
  236.   ELSE BEGIN
  237.     FOR i := 1 TO MaxColumns DO
  238.       NewLine [i] := WORD (Attribut SHL 8);
  239.     NewLine [0] := 0;
  240.        { Hier muss "Längenwort" explizit gesetzt werden ! }
  241.   END;
  242. END;
  243.  
  244. (* ----------------------------------------------------- *)
  245. (* Hier nur als Dummy, da eine Zeile nicht speziell for- *)
  246. (* matiert werden muss. Ein Nachfolger könnte aber diese *)
  247. (* Prozedur z.B. zum Blocksatzformatieren einsetzen.     *)
  248. (* ----------------------------------------------------- *)
  249. PROCEDURE Buffer.FormatLine (VAR Line : OneLine);
  250. BEGIN
  251. END;
  252.  
  253. (* ----------------------------------------------------- *)
  254. (* Sucht die Position des letzten Wortes in einem String.*)
  255. (* Es wird ein Wortende von x an "abwärts" gesucht.      *)
  256. (* ----------------------------------------------------- *)
  257. FUNCTION Buffer.GetLastWord (str : STRING;
  258.                              x : WORD) : WORD;
  259.   VAR Quit : BOOLEAN;
  260. BEGIN
  261.   Inc (x);
  262.   REPEAT
  263.     Dec (x);
  264.     Quit := (Pos (Str [x], WordEndChars)>0) OR (x<1);
  265.   UNTIL Quit;
  266.   IF Pos (Str [x], WordEndChars)>0 THEN
  267.     GetLastWord := x
  268.   ELSE
  269.     GetLastWord := 0;
  270. END;
  271.  
  272. (* ----------------------------------------------------- *)
  273. (* Sucht die "Schnittstelle" in einem String, der über 2 *)
  274. (* Zeilen gehen soll. Berücksichtigt wird hierbei LineEnd*)
  275. (* das angibt, wie eine Zeile beendet werden soll.       *)
  276. (* ----------------------------------------------------- *)
  277. FUNCTION Buffer.GetCutPos (Str : STRING;
  278.                            x : WORD) : WORD;
  279.   VAR cp : WORD;
  280. BEGIN
  281.   CASE LineEnd OF
  282.     CutPrevWord: cp := GetLastWord (str, Columns-x+2);
  283.     WriteOver,
  284.     CutEnd     : cp := Succ (Columns-x);
  285.   END;
  286.   GetCutPos := cp;
  287. END;
  288.  
  289. FUNCTION Buffer.XYInBuf (x, y : WORD) : BOOLEAN;
  290. BEGIN
  291.   IF (x >= 1)       AND (y >= 1) AND
  292.      (x <= Columns) AND (y <= Lines) THEN
  293.     XYInBuf := TRUE
  294.   ELSE BEGIN
  295.     XYInBuf := FALSE;
  296.     ErrorHandling (BufCheckXYErr);
  297.   END;
  298. END;
  299.  
  300. PROCEDURE Buffer.SaveNewLine (y : WORD;
  301.                               VAR Line : OneLine);
  302. BEGIN
  303.   IF (XYInBuf (1, y)) AND (TextBuf^[y]<>NIL) THEN
  304.     Move (Line, TextBuf^[y]^, 2 * Succ (Columns));
  305. END;
  306.  
  307. PROCEDURE Buffer.LoadLine (y : WORD;
  308.                            VAR Line : OneLine);
  309. BEGIN
  310.   IF (TextBuf^[y] <> NIL) AND (XYInBuf (1, y)) THEN
  311.     Move (TextBuf^[y]^, Line, 2 * Succ (Columns));
  312. END;
  313.  
  314. PROCEDURE Buffer.KillLines (Num : WORD);
  315.   VAR i : WORD;
  316.       TLines : WORD;
  317. BEGIN
  318.   TLines := Lines;
  319.   Lines := Lines-Num;
  320.   FOR i := TLines DOWNTO Succ (Lines) DO
  321.     IF (TextBuf^[i] <> NIL) THEN BEGIN
  322.       FreeMem (TextBuf^[i], 2 * Succ (MaxColumns));
  323.       TextBuf^[i] := NIL;
  324.     END;
  325. END;
  326.  
  327. PROCEDURE Buffer.NewLines (Num : WORD);
  328.   VAR i, TLines : WORD;
  329.       MemLimit  : LONGINT;
  330.       DL        : WORD;
  331. BEGIN
  332.   MemLimit := 2 * Succ (MaxColumns) + FreeHeap;
  333.   TLines := Lines;  DL := 0;
  334.   Lines := Lines+Num;
  335.   FOR i := Succ (TLines) TO Lines DO
  336.     IF (MemAvail > MemLimit) THEN BEGIN
  337.       GetMem (TextBuf^[i], 2 * Succ (MaxColumns));
  338.       GetNewLine (Attr, TextBuf^[i]^);
  339.     END ELSE
  340.       Inc (DL);
  341.   Dec (Lines, DL);
  342.   IF DL>0 THEN
  343.     ErrorHandling (BufNoMem);
  344. END;
  345.  
  346. PROCEDURE Buffer.WriteOneLine (str : STRING;
  347.                                x, y : WORD;
  348.                                VAR Line : OneLine);
  349.   VAR i, OldLength, NewLength : WORD;
  350. BEGIN
  351.   IF KillWrite THEN
  352.     GetNewLine (Attr, Line);
  353.   CASE LineForm OF
  354.     Center : x := Columns DIV 2-Length (Str) DIV 2;
  355.     Right  : x := Columns-Length (Str);
  356.   END;
  357.   OldLength := Line [0];
  358.   FOR i := 1 TO Length (str) DO
  359.     Line [Pred (x+i)] := WORD (Ord (str [i])+Attr SHL 8);
  360.   NewLength := Pred (x+Length (str));
  361.   IF (OldLength>NewLength) AND
  362.      NOT (KillLineRest) THEN
  363.     NewLength := OldLength;
  364.   Line [0] := NewLength;
  365.   FormatLine (Line);
  366.   SaveNewLine (y, Line);
  367. END;
  368.  
  369.  
  370. (* ----------------------------------------------------- *)
  371. (* Setzt Lines neu, wobei sich die Angabe NewML *relativ**)
  372. (* auf den momentanen Wert von Lines bezieht. D.h., es   *)
  373. (* ist möglich, die letzten NewML Zeilen zu löschen. Beim*)
  374. (* hinzufügen wird geprüft, ob noch genügend Speicher vor*)
  375. (* handen ist.                                           *)
  376. (* ----------------------------------------------------- *)
  377. PROCEDURE Buffer.SetMaxLines (NewML : INTEGER);
  378. BEGIN
  379.   IF NOT (NewML=0) THEN BEGIN
  380.     IF Lines+NewML>MaxLines THEN
  381.       NewML := MaxLines-Lines;
  382.     IF Lines+NewML<0 THEN
  383.       NewML := Lines;
  384.     IF NewML>0 THEN
  385.       NewLines (NewML)
  386.     ELSE
  387.       KillLines (Abs (NewML));
  388.   END;
  389. END;
  390.  
  391. PROCEDURE Buffer.InsLines (y, No : WORD);
  392.   VAR OldLines, i : WORD;
  393. BEGIN
  394.   IF (y >= 0) AND
  395.      (y <= Lines) THEN BEGIN
  396.     IF y + No > MaxLines THEN
  397.       No := MaxLines - y;
  398.     OldLines := Lines;
  399.     SetMaxLines (No);
  400.     IF GetErrorL1 <> 0 THEN BEGIN
  401.       SetMaxLines (-(Lines-OldLines));
  402.       Exit;
  403.     END;
  404.     LoadLine (Lines, TempLines [InsTL]^);
  405.     FOR i := Lines DOWNTO Succ (y) DO
  406.        CopyLine (i-No, i);
  407.     FOR i := y TO Pred (y+No) DO
  408.       SaveNewLine (i, TempLines [InsTL]^);
  409.   END ELSE
  410.     ErrorHandling (BufInsLineErr);
  411. END;
  412.  
  413. PROCEDURE Buffer.CopyLine (Source, Dest : WORD);
  414. BEGIN
  415.   IF XYInBuf (1,Source) AND
  416.      XYInBuf (1,Dest) THEN BEGIN
  417.     LoadLine (Source, TempLines [CopyTL]^);
  418.     SaveNewLine (Dest, TempLines [CopyTL]^);
  419.   END;
  420. END;
  421.  
  422. PROCEDURE Buffer.DelLines (y, No : WORD);
  423.   VAR i : WORD;
  424. BEGIN
  425.   IF (XYInBuf (1, y)) AND           { Im Pufferbereich ?  }
  426.      (No > 0) THEN BEGIN
  427.     IF y+No > Succ (Lines) THEN
  428.       No := Succ (Lines - y);           { ev. korrigieren }
  429.     FOR i := Succ (y+No) TO Lines DO
  430.       CopyLine (i, i-No);               { umkopieren und  }
  431.     SetMaxLines (-No);      { freigewordene Zeilen löschen}
  432.     IF BufCurY > Lines THEN BEGIN
  433.       BufCurY := Lines;  BufCurX := 1;
  434.     END;
  435.   END ELSE
  436.     ErrorHandling (BufDelLineErr);
  437. END;
  438.  
  439. PROCEDURE Buffer.WriteStrXY (x, y : WORD; Str : STRING);
  440.   VAR s1, s2 : STRING;
  441.       FirstY,
  442.       CutPos : WORD;
  443.       Quit,
  444.       OnePlus: BOOLEAN;
  445.       CountLines : BYTE;
  446.  
  447. BEGIN
  448.   CountLines := 0;  FirstY := y;  Quit := FALSE;
  449.   REPEAT
  450.     {--------------- Checken der Parameter ---------------}
  451.     IF (y=Succ(Lines)) THEN BEGIN
  452.       IF MemAvail-FreeHeap>2*Succ (MaxColumns) THEN
  453.         SetMaxLines (1)  { passt noch in Speicher }
  454.       ELSE
  455.         Inc (Lines);     { vielleicht kann Nachkomme
  456.                            auslagern, sonst geht Zeile
  457.                            verloren }
  458.       OnePlus := TRUE;
  459.     END ELSE
  460.       OnePlus := FALSE;
  461.     IF NOT XYInBuf (1, y) THEN BEGIN
  462.       ErrorHandling (BufWriteStrErr);   Exit;
  463.     END;
  464.  
  465.     IF (x > Columns) THEN BEGIN
  466.       x := 1;  Inc (y);
  467.       IF NOT XYInBuf (1, y) THEN SetMaxLines (1);
  468.       IF GetErrorL1<>BufOk THEN Exit;
  469.     END;
  470.     {----------------- Laden der Zeile -------------------}
  471.     IF TextBuf^[y]=NIL THEN BEGIN
  472.       IF KillWrite OR OnePlus THEN
  473.         GetNewLine (Attr, TempLines [WrtStrTL]^)
  474.       ELSE
  475.         LoadLine (y, TempLines [WrtStrTL]^);
  476.       IF GetErrorL1<>BufOk THEN Exit;
  477.     END ELSE
  478.       LoadLine (y, TempLines [WrtStrTL]^);
  479.     {---------------- ev. aufteilen des Strings ----------}
  480.     s2 := '';
  481.     IF x+Length (Str) > Columns THEN BEGIN
  482.       CutPos := GetCutPos (Str, x);
  483.       IF CutPos=0 THEN BEGIN
  484.         IF LineEnd<>CutPrevWord THEN
  485.           CutPos := x
  486.         ELSE BEGIN
  487.           x := 1;  Inc (y);  s1 := Str;
  488.           Inc (CountLines);
  489.           IF Length (s1) > Columns THEN
  490.             CutPos := GetCutPos (s1, x)
  491.           ELSE
  492.             IF y>Lines THEN BEGIN
  493.               SetMaxLines (1);
  494.               IF GetErrorL1<>BufOk THEN Exit;
  495.             END;
  496.         END;
  497.       END;
  498.       IF CutPos<>0 THEN BEGIN
  499.         s1 := Copy (Str, 1, Cutpos);
  500.         IF LineEnd<>CutEnd THEN
  501.           s2 := Copy (Str, CutPos+1, Length (Str)-CutPos);
  502.       END;
  503.     END ELSE
  504.       s1 := Str;
  505.     {------------- schreiben der ersten Zeile ------------}
  506.     WriteOneLine (s1, x, y, TempLines [WrtStrTL]^);
  507.  
  508.     IF (s2<>'') THEN BEGIN        { mehr als eine Zeile ? }
  509.       Str := s2;        s1 := '';  s2 := '';
  510.       y   := Succ (y);  x  := 1
  511.     END ELSE Str := '';
  512.     Inc (CountLines);
  513.     Quit := (Str='')
  514.   UNTIL Quit;
  515.   {------------------- Cursor bewegen --------------------}
  516.   IF MoveBufCur  THEN BEGIN
  517.     BufCurY := Pred (FirstY + CountLines);
  518.     IF CountLines > 1 THEN BEGIN
  519.       BufCurX := Succ (GetLineLength (BufCurY));
  520.       IF (BufCurX>Columns) AND NOT LineFeed THEN BEGIN
  521.         IF BufCurY=Lines THEN
  522.           SetMaxLines (1);
  523.         IF GetErrorL1<>BufOk THEN
  524.           BufCurX := 1
  525.         ELSE BEGIN
  526.           BufCurX := 1;
  527.           Inc (BufCurY);
  528.         END;
  529.       END;
  530.     END ELSE
  531.       BufCurX := x + Length (s1);
  532.  
  533.     IF LineFeed THEN BEGIN
  534.       IF BufCurY=Lines THEN
  535.         SetMaxLines (1);
  536.       IF GetErrorL1=BufOk THEN BEGIN
  537.         BufCurX := 1;
  538.         Inc (BufCurY);
  539.       END ELSE
  540.         BufCurX := 1;
  541.     END;
  542.   END;
  543. END;
  544.  
  545. PROCEDURE Buffer.WriteStr (Str : STRING);
  546. BEGIN
  547.   WriteStrXY (BufCurX, BufCurY, Str);
  548. END;
  549.  
  550. PROCEDURE Buffer.ChangeColor
  551.             (x1, y1, x2, y2 : WORD;
  552.              NewCol, NewBackCol : BYTE);
  553.   VAR x, y, NewAttr : WORD;
  554. BEGIN
  555.   IF XYInBuf (x1, y1) AND
  556.      XYInBuf (x2, y2) AND
  557.      (x2 >= x1) AND (y2 >= y1) THEN BEGIN
  558.     NewAttr := NewCol + NewBackCol SHL 4;
  559.     FOR y := y1 TO y2 DO BEGIN
  560.       LoadLine (y, TempLines [TL]^);
  561.       FOR x := x1 TO x2 DO
  562.         TempLines [TL]^[x] :=
  563.           WORD (Lo (TempLines [TL]^[x])+NewAttr SHL 8);
  564.       SaveNewLine (y, TempLines [TL]^);
  565.     END;
  566.   END;
  567. END;
  568.  
  569. (* ----------------------------------------------------- *)
  570. (* SetColumns setzt die Spaltenbreite, mit der gerechnet *)
  571. (* wird, so z.B. in WriteStrXY. Dabei können schon be-   *)
  572. (* stehende Spalten "vergessen" werden !                 *)
  573. (* ----------------------------------------------------- *)
  574. PROCEDURE Buffer.SetColumns (Cols : WORD);
  575. BEGIN
  576.   IF (Cols>=MinColumns) AND (Cols<=MaxMaxColumns) THEN
  577.     Columns := Cols;
  578. END;
  579.  
  580. PROCEDURE Buffer.SetWriteColor (Col, Back : BYTE);
  581. BEGIN
  582.   IF Col>15+128 THEN
  583.     Col := 143;
  584.   IF Back>7 THEN
  585.     Back := 7;
  586.   Attr := Col + Back SHL 4;
  587. END;
  588.  
  589. PROCEDURE Buffer.SetBufCursor (x, y : WORD);
  590. BEGIN
  591.   IF XYInBuf(x, y) THEN BEGIN
  592.     BufCurX := x;  BufCurY := y;
  593.   END;
  594. END;
  595.  
  596. PROCEDURE Buffer.SetMoveCursor (MC : BOOLEAN);
  597. BEGIN
  598.   MoveBufCur := MC;
  599. END;
  600.  
  601. PROCEDURE Buffer.SetKillRest (KR : BOOLEAN);
  602. BEGIN
  603.   KillLineRest := KR;
  604. END;
  605.  
  606. PROCEDURE Buffer.SetKillWriting (KW : BOOLEAN);
  607. BEGIN
  608.   KillWrite := KW;
  609. END;
  610.  
  611. PROCEDURE Buffer.SetLineFeed (LF : BOOLEAN);
  612. BEGIN
  613.   LineFeed := LF;
  614. END;
  615.  
  616. PROCEDURE Buffer.SetAttr (NewAttr : BYTE);
  617. BEGIN
  618.   Attr := NewAttr;
  619. END;
  620.  
  621. PROCEDURE Buffer.SetLineForm (LF : FormatTypes);
  622. BEGIN
  623.   LineForm := LF;
  624. END;
  625.  
  626. PROCEDURE Buffer.SetLineEnding (LE : LineEndType);
  627. BEGIN
  628.   LineEnd := LE;
  629. END;
  630.  
  631. PROCEDURE Buffer.SetWordEndChrs (WECs : STRING);
  632. BEGIN
  633.   WordEndChars := WECs;
  634. END;
  635.  
  636. PROCEDURE Buffer.GetBufXYColors
  637.             (x, y : WORD; VAR Col, BackCol : BYTE);
  638.   VAR a : BYTE;
  639. BEGIN
  640.   IF XYInBuf (x, y) THEN BEGIN
  641.     LoadLine (y, TempLines [TL]^);
  642.     a := Hi (TempLines [TL]^[x]);
  643.     Col := a AND 15;   BackCol := a AND 112 DIV 16;
  644.   END;
  645. END;
  646.  
  647. FUNCTION Buffer.Convert2Str (y : WORD) : STRING;
  648.   VAR i : WORD;
  649.       str : STRING;
  650. BEGIN
  651.   IF XYInBuf (1, y) THEN BEGIN
  652.     i := 1;  str := '';
  653.     LoadLine (y, TempLines [ConvTL]^);
  654.     IF TempLines [ConvTL]^[0] <> 0 THEN
  655.       REPEAT
  656.         Str := str + Chr (Lo (TempLines [ConvTL]^[i]));
  657.         Inc (i);
  658.       UNTIL (i>TempLines [ConvTL]^[0]) OR (i>255);
  659.     Convert2Str := Str;
  660.   END ELSE
  661.     Convert2Str := '';
  662. END;
  663.  
  664. FUNCTION Buffer.GetLinePtr (y : WORD) : OneLinePtr;
  665. BEGIN
  666.   IF y<=Lines THEN
  667.     GetLinePtr := @TextBuf^[y]^
  668.   ELSE
  669.     GetLinePtr := NIL;
  670. END;
  671.  
  672. FUNCTION Buffer.GetLineLength (y : WORD) : WORD;
  673. BEGIN
  674.   IF XYInBuf (1,y) THEN BEGIN
  675.     LoadLine (y, TempLines [GetLLTL]^);
  676.     GetLineLength := TempLines [GetLLTL]^[0];
  677.   END ELSE
  678.     GetLineLength := MaxInt;
  679. END;
  680.  
  681. FUNCTION Buffer.GetBufXYAttr (x, y: WORD) : BYTE;
  682. BEGIN
  683.   IF XYInBuf (x, y) THEN BEGIN
  684.     LoadLine (y, TempLines [TL]^);
  685.     GetBufXYAttr := Hi (TempLines [TL]^[x]);
  686.   END;
  687. END;
  688.  
  689. FUNCTION Buffer.GetMoveCursor : BOOLEAN;
  690. BEGIN
  691.   GetMoveCursor := MoveBufCur;
  692. END;
  693.  
  694. FUNCTION Buffer.GetKillRest : BOOLEAN;
  695. BEGIN
  696.   GetKillRest := KillLineRest;
  697. END;
  698.  
  699. FUNCTION Buffer.GetKillWriting : BOOLEAN;
  700. BEGIN
  701.   GetKillWriting := KillWrite;
  702. END;
  703.  
  704. FUNCTION Buffer.GetLineFeed : BOOLEAN;
  705. BEGIN
  706.   GetLineFeed := LineFeed;
  707. END;
  708.  
  709. FUNCTION Buffer.GetErrorL1 : WORD;
  710. BEGIN
  711.   GetErrorL1 := BufErrorL1;
  712. END;
  713.  
  714. FUNCTION Buffer.GetErrorL2 : WORD;
  715. BEGIN
  716.   GetErrorL2 := BufErrorL2;
  717. END;
  718.  
  719. FUNCTION Buffer.GetX : WORD;
  720. BEGIN
  721.   GetX := BufCurX;
  722. END;
  723.  
  724. FUNCTION Buffer.GetY : WORD;
  725. BEGIN
  726.   GetY := BufCurY;
  727. END;
  728.  
  729. FUNCTION Buffer.GetColumns : WORD;
  730. BEGIN
  731.   GetColumns := Columns;
  732. END;
  733.  
  734. FUNCTION Buffer.GetMaxColumns : WORD;
  735. BEGIN
  736.   GetMaxColumns := MaxColumns;
  737. END;
  738.  
  739. FUNCTION Buffer.GetLines : WORD;
  740. BEGIN
  741.   GetLines := Lines;
  742. END;
  743.  
  744. FUNCTION Buffer.GetMaxLines : WORD;
  745. BEGIN
  746.   GetMaxLines := MaxLines;
  747. END;
  748.  
  749. FUNCTION Buffer.GetAttr : BYTE;
  750. BEGIN
  751.   GetAttr := Attr;
  752. END;
  753.  
  754. FUNCTION Buffer.GetLineForm : FormatTypes;
  755. BEGIN
  756.   GetLineForm := LineForm;
  757. END;
  758.  
  759. FUNCTION Buffer.GetLineEnding : LineEndType;
  760. BEGIN
  761.   GetLineEnding := LineEnd;
  762. END;
  763.  
  764. FUNCTION Buffer.GetWordEndChars  : STRING;
  765. BEGIN
  766.   GetWordEndChars := WordEndChars;
  767. END;
  768.  
  769. FUNCTION Buffer.GetFreeHeap : WORD;
  770. BEGIN
  771.   GetFreeHeap := FreeHeap;
  772. END;
  773.  
  774. (* ----------------------------------------------------- *)
  775. (* Gibt den benutzten Speicher frei.                     *)
  776. (* ----------------------------------------------------- *)
  777. DESTRUCTOR Buffer.Done;
  778.   VAR i : WORD;
  779. BEGIN
  780.   IF TextBuf<>NIL THEN BEGIN
  781.     FOR i := 1 TO Lines DO
  782.       IF TextBuf^[i]<>NIL THEN BEGIN
  783.         FreeMem (TextBuf^[i], 2 * Succ (MaxColumns));
  784.         TextBuf^[i] := NIL;
  785.       END;
  786.   END;
  787.   IF InfoLine<>NIL THEN BEGIN
  788.     FreeMem (InfoLine, 2 * Succ (MaxColumns));
  789.     InfoLine := NIL;
  790.   END;
  791.   FOR i := CopyTL TO TL DO
  792.     IF TempLines [i]<>NIL THEN
  793.       FreeMem (TempLines [i], 2 * Succ (MaxColumns));
  794.   IF TextBuf<>NIL THEN BEGIN
  795.     FreeMem (TextBuf, 4 * Succ (MaxLines));
  796.     TextBuf := NIL;
  797.   END;
  798. END;
  799.  
  800. BEGIN
  801.   FOR i := CopyTL TO TL DO
  802.     TempLines [i] := NIL;
  803. END.
  804. (* ----------------------------------------------------- *)
  805. (*                 Ende von UBUFFER.PAS                  *)
  806. (* ----------------------------------------------------- *)
  807.  
  808.