home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 10 / oop / buffer5.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-06-26  |  34.9 KB  |  940 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    BUFFER5.PAS                         *)
  3. (*                                                        *)
  4. (*   Diese Unit implementiert das Objekt BufferObj, das   *)
  5. (* das dazu dient, Daten in einem Puffer zu verarbeiten.  *)
  6. (* Falls der Hauptspeicher nicht ausreicht, werden die    *)
  7. (* Daten auf Diskette/Festplatte ausgelagert.             *)
  8. (*                                                        *)
  9. (*         (c) 1990 R.Reichert & TOOLBOX                  *)
  10. (* ------------------------------------------------------ *)
  11. UNIT Buffer5;
  12.  
  13. INTERFACE
  14.  
  15. CONST
  16.   { "MaxLines" und "Columns" sollten vor dem Aufruf von    }
  17.   { "BufferObj.Init" auf den gewünschten Wert gesetzt      }
  18.   { werden. Der maximale Wrt für "MaxLines" ist 18382, der }
  19.   { für "MaxColumns" 32766, der Speicherbedarf errechnet   }
  20.   { sich nach "Columns".                                   }
  21.   { Da die Belegung und Freigabe des Speichers über        }
  22.   { "GetMem" und "FreeMem" erfolgt, darf die Variable      }
  23.   { "Columns" nicht während des Programmlaufs geändert     }
  24.   { werden.                                                }
  25.  
  26.   MaxMaxLines           = 16000;
  27.   MaxLines    : WORD    = 2000;
  28.   MaxColumns            = 32766;
  29.   MinColumns            = 10;
  30.   FreeHeap    : LongInt = 1024;
  31.   BufInitErr            = -1;
  32.   BufNoErr              =  0;
  33.   BufInsLineErr         =  1;
  34.   BufDelLineErr         =  2;
  35.   BufWriteStrErr        =  3;
  36.   BufCheckXYErr         =  4;
  37.   BufFileErr            =  5;
  38.   BufDiskFull           =  6;
  39.  
  40.   BufErrTxt   : ARRAY [BufInitErr..BufDiskFull] OF
  41.                   STRING [80] =
  42.     ('Fehler in Init (nicht genügend Speicher für ' +
  43.      'Datenstruktur).',
  44.      'Kein Fehler aufgetreten',
  45.      'Fehler beim Einfügen einer Zeile',
  46.      'Fehler beim Löschen einer Zeile',
  47.      'Fehler in WriteStrXY',
  48.      'X/Y-Koordinate außerhalb Puffer (XYInBuf)!',
  49.      'Fehler beim Auslagern',
  50.      'Festplatte/Diskette voll, Auslagern nicht mehr' +
  51.      ' möglich');
  52.  
  53. TYPE
  54.   LineEndType  = (WriteOver, CutEnd, CutPrevWord);
  55.   FormatTypes  = (Left, Center, Right);
  56.   OneLinePtr   = ^OneLine;
  57.   OneLine      = ARRAY [0..MaxColumns] OF WORD;
  58.   BufferPtr    = ^Buffer;
  59.   Buffer       = ARRAY [0..MaxMaxLines] OF OneLinePtr;
  60.  
  61.   BufferObjPtr = ^BufferObj;
  62.  
  63.   BufferObj    =
  64.     OBJECT
  65.       InitError,                   { Fehler in Init        }
  66.       MoveBufCur,                  { "Cursor" bewegen ?    }
  67.       KillLineRest,                { Zeilenrest löschen    }
  68.       KillWrite,                   { vor Schreiben löschen }
  69.       LineFeed,                    { Zeilenvorschub ?      }
  70.       AllSaved,                    { Alles gespeichert ?   }
  71.       SaveData     : BOOLEAN;      { Datei löschen ?       }
  72.       BufErrorL1,                  { Fehler-Nr Level 1     }
  73.       BufErrorL2,                  { Level 2,              }
  74.       BufDosErr,                   { Dos-Fehlercode        }
  75.       BufCurX,                     { Cursor-X-Position     }
  76.       BufCurY,                     { Cursor-Y-Position     }
  77.       Columns,                     { Anzahl Spalten        }
  78.       Lines        : INTEGER;      { Anz. Zeilen           }
  79.       BufCol,                      { "Schreib"-Farbe       }
  80.       BufBackCol,                  { Hintergrundfarbe      }
  81.       Attr         : BYTE;         { res. Attrib.          }
  82.       TextBuf      : BufferPtr;    { Pufferzeiger          }
  83.       LineForm     : FormatTypes;  { Zeilenende            }
  84.       LineEnd      : LineEndType;  { Ausrichtung           }
  85.       WordEndChars,
  86.       SEFileName,                { Dateiname zum Auslagern }
  87.       EndName,
  88.       SEPath       : STRING;
  89.       InfoLine     : OneLinePtr;
  90.       f            : FILE;
  91.  
  92.       CONSTRUCTOR Init(BufData : BufferObj);
  93.  
  94.       PROCEDURE ErrorHandling(Nr : INTEGER);        VIRTUAL;
  95.       PROCEDURE SetMaxLines(NewML : INTEGER);       VIRTUAL;
  96.       PROCEDURE GetNewLine(Attribut    : BYTE;
  97.                            VAR NewLine : OneLine);  VIRTUAL;
  98.       PROCEDURE SaveAll;                            VIRTUAL;
  99.       PROCEDURE SaveFrom(y : INTEGER);              VIRTUAL;
  100.       PROCEDURE SaveLine(y : INTEGER);              VIRTUAL;
  101.       PROCEDURE SaveNewLine(y        : INTEGER;
  102.                             VAR Line : OneLine;
  103.                             OnlyDisk : BOOLEAN);    VIRTUAL;
  104.       PROCEDURE SaveNewDrive(NewDrive : STRING);    VIRTUAL;
  105.       PROCEDURE Flush;                              VIRTUAL;
  106.       PROCEDURE LoadLine(y        : INTEGER;
  107.                          VAR Line : OneLine);       VIRTUAL;
  108.       PROCEDURE LoadPart(y1, y2 : INTEGER);         VIRTUAL;
  109.       PROCEDURE CloseFile;                          VIRTUAL;
  110.       PROCEDURE InsLines(y, No : INTEGER);          VIRTUAL;
  111.       PROCEDURE CopyLine(Source, Dest : INTEGER);   VIRTUAL;
  112.       PROCEDURE DelLines(y, No : INTEGER);          VIRTUAL;
  113.       PROCEDURE WriteStrXY(x, y : INTEGER;
  114.                            Str  : STRING);          VIRTUAL;
  115.       PROCEDURE WriteStr(Str : STRING);             VIRTUAL;
  116.       PROCEDURE FormatLine(VAR Line : OneLine);     VIRTUAL;
  117.       FUNCTION  GetCutPos(Str : STRING;
  118.                           x   : INTEGER) : INTEGER; VIRTUAL;
  119.       FUNCTION  GetLastWord(Str : STRING;
  120.                             x : INTEGER) : INTEGER; VIRTUAL;
  121.       FUNCTION  Convert2Str(y : INTEGER) : STRING;  VIRTUAL;
  122.       FUNCTION  GetLineLength(y : INTEGER): INTEGER;VIRTUAL;
  123.       PROCEDURE SetWriteColor(Col, BackCol : BYTE); VIRTUAL;
  124.       PROCEDURE ChangeColor(x1, y1, x2, y2 : INTEGER;
  125.                            NewCol, NewBackCol:BYTE);VIRTUAL;
  126.       PROCEDURE SetBufCursor(x, y : INTEGER);       VIRTUAL;
  127.       PROCEDURE GetBufXYColors(x, y : INTEGER;
  128.                                VAR Col, BackCol : BYTE);
  129.                                                     VIRTUAL;
  130.       FUNCTION GetBufXYAttr(x, y : INTEGER) : BYTE; VIRTUAL;
  131.       FUNCTION XYInBuf(x, y : INTEGER) : BOOLEAN;   VIRTUAL;
  132.  
  133.       DESTRUCTOR Done;                              VIRTUAL;
  134.     END;
  135.  
  136. CONST
  137.   BufData      : BufferObj = (InitError    : FALSE;
  138.                               MoveBufCur   : FALSE;
  139.                               KillLineRest : FALSE;
  140.                               KillWrite    : FALSE;
  141.                               LineFeed     : FALSE;
  142.                               AllSaved     : FALSE;
  143.                               SaveData     : FALSE;
  144.                               BufErrorL1   : 0;
  145.                               BufErrorL2   : 0;
  146.                               BufDosErr    : 0;
  147.                               BufCurX      : 1;
  148.                               BufCurY      : 1;
  149.                               Columns      : 0;
  150.                               Lines        : 0;
  151.                               BufCol       : 1;
  152.                               BufBackCol   : 0;
  153.                               Attr         : 0;
  154.                               TextBuf      : NIL;
  155.                               LineForm     : Left;
  156.                               LineEnd      : CutPrevWord;
  157.                               WordEndChars : ')+!?,./;:-─ ';
  158.                               SEFileName   : '';
  159.                               EndName      : '';
  160.                               SEPath       : '');
  161.  
  162. IMPLEMENTATION
  163.  
  164. CONST
  165.   CopyTL   = 1;  InsTL    = 2;  GetLLTL  = 3;  SetMLTL  = 4;
  166.   LPTL     = 5;  WrtStrTL = 6;  ConvTL   = 7;  TL       = 8;
  167.  
  168. VAR
  169.   TempLines : ARRAY [CopyTL..TL] OF OneLinePtr;
  170.   Time      : LongInt ABSOLUTE $40:$6C;
  171.   i         : INTEGER;
  172.  
  173. (* ------------------------------------------------------ *)
  174. (* Initialisiert mit den in "BufData" übergebenen Daten.  *)
  175. (* Wenn nicht genügend Speicher für die Datenstruktur     *)
  176. (* vorhanden ist, werden "BufErrorL2" und "InitError" ge- *)
  177. (* setzt und die Standardprozedur "Fail" aufgerufen.      *)
  178. (* Ein Programm sollte immer den Init-Error abfragen und  *)
  179. (* im Fehlerfall abbrechen. Die Methoden fragen           *)
  180. (* "InitError" nicht ab!                                  *)
  181. (* Am Ende werden ein paar Variablen gesetzt, die zu Be-  *)
  182. (* ginn immer den gleichen Wert haben (müssen). Falls für *)
  183. (* "Columns" oder "Lines" ungültige Werte angegeben wur-  *)
  184. (* wurden, ist "InitError" TRUE. Dasselbe geschieht, wenn *)
  185. (* nicht genügend Speicher für die Aufnahme der Zeilen    *)
  186. (* vorhanden ist.                                         *)
  187. (* ------------------------------------------------------ *)
  188.   CONSTRUCTOR BufferObj.Init(BufData : BufferObj);
  189.   VAR
  190.     MemLimit, i : LongInt;
  191.   BEGIN
  192.     Self := BufData;
  193.     GetMem(TextBuf, 4 * Succ (MaxLines));
  194.     IF (TextBuf = NIL) OR             { Genügend Speicher? }
  195.        (Columns > MaxColumns) OR      { Columns zulässig ? }
  196.        (Columns < MinColumns) OR
  197.        (Lines > MaxLines) THEN BEGIN  { Lines in Ordnung ? }
  198.       InitError := TRUE;
  199.       ErrorHandling(BufInitErr);  Done;  Fail;
  200.     END;
  201.     InitError := FALSE;
  202.     MemLimit := (MemAvail - (FreeHeap + 2 * Succ(Columns)));
  203.  
  204.           { Genug Speicher für temp. Zeilen und InfoLine ? }
  205.     IF 2 * Succ(Columns) * Succ(TL) > MemLimit THEN BEGIN
  206.       InitError := TRUE;
  207.       ErrorHandling(BufInitErr);  Done;  Fail;
  208.     END;
  209.     FOR i := CopyTL TO TL DO BEGIN      { Speicher für die }
  210.       GetMem(TempLines[i], 2 * Succ(Columns));
  211.       IF TempLines[i] = NIL THEN        { temp. Zeilen     }
  212.         InitError := TRUE
  213.     END;
  214.     GetMem(InfoLine, 2 * Succ(Columns));
  215.     IF (InitError) OR (InfoLine = NIL) THEN BEGIN
  216.       ErrorHandling(BufInitErr);  Done;  Fail;
  217.     END;
  218.     GetNewLine(0, InfoLine^);
  219.     BufErrorL1 := BufNoErr;    BufErrorL2 := BufNoErr;
  220.     BufDosErr  := 0;           AllSaved   := FALSE;
  221.     BufCurX    := 1;           BufCurY    := 1;
  222.     FOR i := 1 TO MaxLines DO
  223.       TextBuf^[i] := NIL;
  224.     IF Lines > 0 THEN BEGIN
  225.       i := Lines;  Lines := 0;
  226.      { Ausreichend Speicher für die angeforderten Zeilen ? }
  227.       IF 2 * Succ (Columns) * i < MemLimit THEN
  228.         SetMaxLines (i)
  229.       ELSE BEGIN
  230.         InitError := TRUE;
  231.         ErrorHandling(BufInitErr);  Done;  Fail;
  232.       END;
  233.     END;
  234.   END;
  235.  
  236. (* ------------------------------------------------------ *)
  237. (* Setzt "BufErrorL1" bzw. "L2" von "BufferObj" mit "Nr". *)
  238. (* Falls die Schalter "Test" oder "Test2" für bedingte    *)
  239. (* Compilierung gesetzt sind, wird die Fehlermeldung aus- *)
  240. (* gegeben (Testphase eines Programms).                   *)
  241. (* ------------------------------------------------------ *)
  242.   PROCEDURE BufferObj.ErrorHandling(Nr : INTEGER);
  243.   BEGIN
  244.   {$IFDEF TEST}
  245.     WriteLn (^G, '*** Fehler: ', BufErrTxt[Nr]);
  246.   {$ENDIF}
  247.   {$IFDEF TEST2}
  248.     WriteLn (Lst, ^G'*** Fehler: ', BufErrTxt[Nr]);
  249.   {$ENDIF}
  250.     IF (Nr = BufDiskFull) OR (Nr = BufFileErr) THEN
  251.       BufErrorL1 := Nr
  252.     ELSE
  253.       BufErrorL2 := Nr;
  254.   END;
  255.  
  256. (* ------------------------------------------------------ *)
  257. (* Setzt Lines neu, wobei sich die Angabe "NewML" relativ *)
  258. (* auf den momentanen Wert von Lines bezieht. Es ist also *)
  259. (* möglich, die letzten "NewML" Zeilen zu löschen. Beim   *)
  260. (* hinzufügen wird geprüft, ob noch genügend Speicher     *)
  261. (* vorhanden ist. Reicht der Speicher nicht aus, wird     *)
  262. (* alles in eine temporäre Datei geschrieben und die neue *)
  263. (* Zeile daran angehängt. Lines erhält den neuen Wert.    *)
  264. (* ------------------------------------------------------ *)
  265.   PROCEDURE BufferObj.SetMaxLines(NewML : INTEGER);
  266.   VAR
  267.     OldLines : INTEGER;
  268.     Kill     : BOOLEAN;
  269.  
  270.     (* -------------------------------------------------- *)
  271.     (* Löscht Zeilen zwischen "OldLines" und "Lines".     *)
  272.     PROCEDURE KillLines;
  273.     VAR
  274.       i : INTEGER;
  275.     BEGIN
  276.       FOR i := Lines DOWNTO OldLines DO
  277.         IF (TextBuf^[i] <> NIL) THEN BEGIN
  278.           FreeMem(TextBuf^[i], 2 * Succ(Columns));
  279.           TextBuf^[i] := NIL
  280.         END ELSE IF (BufErrorL1 <> BufFileErr) THEN BEGIN
  281.           Seek(f, Pred(i));
  282.           Truncate (f);
  283.           IF BufErrorL1 = BufDiskFull THEN
  284.             BufErrorL1 := BufNoErr
  285.         END;
  286.       Lines := Pred(OldLines);
  287.     END;
  288.  
  289.     (* -------------------------------------------------- *)
  290.     (* Gegenstück zu KillLines, hängt neue Zeilen an.     *)
  291.     (* Wenn im Speicher kein Platz mehr vorhanden ist,    *)
  292.     (* wird ausgelagert.                                  *)
  293.     PROCEDURE NewLines;
  294.     VAR
  295.       i, DummyLine, MemLimit : LongInt;
  296.     BEGIN
  297.       DummyLine := 0;
  298.       MemLimit  := 2 * Succ(Columns) + FreeHeap;
  299.       Attr      := BufCol + BufBackCol * 16;
  300.       FOR i := OldLines TO Lines DO
  301.         IF (MemAvail > MemLimit) THEN BEGIN
  302.           GetMem(TextBuf^[i], 2 * Succ (Columns));
  303.           GetNewLine(Attr, TextBuf^[i]^)
  304.         END ELSE BEGIN
  305.           IF (NOT AllSaved) AND
  306.              (BufErrorL1 <> BufFileErr) THEN
  307.             SaveAll;
  308.           IF (BufErrorL1 <> BufDiskFull) AND
  309.              (BufErrorL1 <> BufFileErr) THEN BEGIN
  310.             GetNewLine(Attr, TempLines [SetMLTL]^);
  311.             SaveNewLine(i, TempLines [SetMLTL]^, TRUE)
  312.           END;
  313.           IF (BufErrorL1 = BufDiskFull) OR
  314.              (BufErrorL1 = BufFileErr) THEN
  315.             Inc(DummyLine);
  316.         END;
  317.       Dec(Lines, DummyLine);
  318.     END;
  319.  
  320.   BEGIN  { SetMaxLines }
  321.     IF NOT (NewML = 0) THEN BEGIN            { +/- Lines ? }
  322.       Kill := FALSE;
  323.       IF NewMl > 0 THEN BEGIN           { hinzufügen ?     }
  324.         OldLines := Succ(Lines);
  325.         Lines    := Lines + NewMl;
  326.         IF Lines > MaxLines THEN Lines := MaxLines
  327.       END ELSE BEGIN
  328.         IF Lines + NewMl < 0 THEN NewMl := -Lines;
  329.         OldLines := Succ(Lines + NewMl);
  330.         Kill     := TRUE;
  331.         IF OldLines < 0 THEN OldLines := 0
  332.       END;
  333.       IF Kill THEN KillLines
  334.               ELSE NewLines;
  335.     END;
  336.   END;
  337.  
  338. (* ------------------------------------------------------ *)
  339. (* Gibt eine neue Zeile mit Attribut in "NewLine" zurück. *)
  340. (* ------------------------------------------------------ *)
  341.   PROCEDURE BufferObj.GetNewLine(Attribut : BYTE;
  342.                                  VAR NewLine : OneLine);
  343.   VAR
  344.     i : INTEGER;
  345.   BEGIN
  346.     IF Attribut = 0 THEN
  347.       FillChar(NewLine, SizeOf(OneLine), 0)
  348.     ELSE BEGIN
  349.       FOR i := 1 TO Columns DO
  350.         NewLine[i] := Attribut SHL 8;
  351.       NewLine [0] := 0
  352.           { Hier muß "Längenwort" explizit gesetzt werden! }
  353.     END;
  354.   END;
  355.  
  356. (* ------------------------------------------------------ *)
  357. (* Bildet einen Dateinamen aus der aktuellen Uhrzeit. In  *)
  358. (* In diese temporäre Datei wird ausgelagert.             *)
  359. (* ------------------------------------------------------ *)
  360.   PROCEDURE BufferObj.SaveAll;
  361.   BEGIN
  362.     Str(Time, SEFileName);
  363.     IF Length(SEFileName) > 8 THEN
  364.       Delete(SEFileName, 1, Length(SEFileName) - 8);
  365.     IF (SEPath <> '') AND
  366.        (SEPath[Length(SEPath)] <> '\') AND
  367.        (SEPath[Length(SEPath)] <> ':') THEN
  368.       SEPath := SEPath + '\';
  369.     SEFileName := SEPath + SEFileName + '.$$$';
  370.     {$I-}
  371.     Assign(f, SEFileName);
  372.     Rewrite(f, Succ(Columns) * 2);
  373.     {$I+}
  374.     BufDosErr := IOResult;
  375.     IF BufDosErr <> 0 THEN
  376.       ErrorHandling(BufFileErr)
  377.     ELSE BEGIN
  378.       AllSaved := TRUE;  SaveFrom(0);
  379.     END;
  380.   END;
  381.  
  382. (* ------------------------------------------------------ *)
  383. (* Speichert von y bis Lines. Bedingung: AllSaved = TRUE! *)
  384. (* ------------------------------------------------------ *)
  385.   PROCEDURE BufferObj.SaveFrom(y : INTEGER);
  386.   VAR
  387.     i : INTEGER;
  388.   BEGIN
  389.     IF AllSaved THEN BEGIN     { schon einmal gespeichert? }
  390.       i := y;
  391.       IF (BufErrorL1 <> BufFileErr) THEN
  392.         WHILE (NOT(i > Lines)) AND
  393.               (BufErrorL1 <> BufDiskFull) DO BEGIN
  394.           SaveLine(i);  Inc(i);    { zeilenweise speichern }
  395.         END;
  396.     END;
  397.   END;
  398.  
  399. (* ------------------------------------------------------ *)
  400. (* Speichert eine Zeile aus dem Speicher ab. Die Routine  *)
  401. (* prüft nur, ob die Zeile nicht ausgelagert ist, nimmt   *)
  402. (* jedoch keine Bereichsüberprüfung vor. Als "Nullte"     *)
  403. (* Zeile wird "InfoLine" gespeichert.                     *)
  404. (* ------------------------------------------------------ *)
  405.   PROCEDURE BufferObj.SaveLine(y : INTEGER);
  406.   BEGIN
  407.     IF y = 0 THEN
  408.       SaveNewLine(y, InfoLine^, TRUE)
  409.     ELSE IF TextBuf^[y] <> NIL THEN
  410.       SaveNewLine(y, TextBuf^[y]^, TRUE)
  411.   END;
  412.  
  413. (* ------------------------------------------------------ *)
  414. (* Speichert die übergebene Zeile "Line" ab. Hier werden  *)
  415. (* Bereichs- und Dateifehler erkannt. Ist die Zeile nicht *)
  416. (* ausgelagert, wird "Line" nicht extern gespeichert,     *)
  417. (* sondern im Speicher abgelegt. OnlyDisk = TRUE erzwingt *)
  418. (* ein Schreiben auf Diskette.                            *)
  419. (* ------------------------------------------------------ *)
  420.   PROCEDURE BufferObj.SaveNewLine(y        : INTEGER;
  421.                                   VAR Line : OneLine;
  422.                                   OnlyDisk : BOOLEAN);
  423.   BEGIN
  424.     IF (y >= 0) AND (y <= Lines) AND (AllSaved) AND
  425.        ((OnlyDisk) OR (TextBuf^[y] = NIL)) AND
  426.        (BufErrorL1 <> BufFileErr) THEN BEGIN
  427.       {$I-}
  428.       Seek(f, y);  BlockWrite(f, Line, 1);
  429.       {$I+}
  430.       BufDosErr := IOResult;
  431.       IF (BufDosErr <> 0) THEN Errorhandling(BufDiskFull);
  432.     END;
  433.     IF (XYInBuf(1, y)) AND (NOT OnlyDisk) AND
  434.        (TextBuf^[y] <> NIL) THEN
  435.       Move(Line, TextBuf^[y]^, 2 * Succ(Columns));
  436.   END;
  437.  
  438. (* ------------------------------------------------------ *)
  439. (* Falls eine Diskette voll ist, kann mit "SaveNewDrive"  *)
  440. (* auf einen anderen Datenträger gespeichert werden.      *)
  441. (* ------------------------------------------------------ *)
  442.   PROCEDURE BufferObj.SaveNewDrive(NewDrive : STRING);
  443.   BEGIN
  444.     IF AllSaved THEN BEGIN
  445.       IF (BufErrorL1 = BufDiskFull) OR
  446.          (BufErrorL1 = BufFileErr) THEN
  447.         BufErrorL1 := BufNoErr;
  448.       {$I-}
  449.       Close (f);
  450.       {$I+}
  451.       SEPath := NewDrive;  AllSaved := FALSE;  SaveAll;
  452.     END;
  453.   END;
  454.  
  455. (* ------------------------------------------------------ *)
  456. (* Bildet die Turbo-Prozedur Flush() nach, die nur für    *)
  457. (* Textdateien gültig ist.                                *)
  458. (* ------------------------------------------------------ *)
  459.   PROCEDURE BufferObj.Flush;
  460.   BEGIN
  461.     IF (AllSaved) AND (BufErrorL1 <> BufFileErr) THEN BEGIN
  462.       Close(f);  Reset(f, 2 * Succ(Columns));
  463.     END;
  464.   END;
  465.  
  466. (* ------------------------------------------------------ *)
  467. (* Lädt eine Zeile aus der Datei oder dem Speicher        *)
  468. (* ------------------------------------------------------ *)
  469.   PROCEDURE BufferObj.LoadLine(y        : INTEGER;
  470.                                VAR Line : OneLine);
  471.   BEGIN
  472.     IF (y >= 0) AND (y <= Lines) AND (AllSaved) AND
  473.        (BufErrorL1 <> BufFileErr) AND
  474.        (TextBuf^[y] = NIL) THEN BEGIN
  475.       {$I-}
  476.       Seek(f, y);  BlockRead(f, Line, 1);
  477.       {$I+}
  478.       BufDosErr := IOResult;
  479.       IF BufDosErr <> 0 THEN
  480.          ErrorHandling(BufFileErr);
  481.     END ELSE IF (TextBuf^[y] <> NIL) AND
  482.                 (XYInBuf(1, y)) THEN
  483.       Move(TextBuf^[y]^, Line, 2 * Succ(Columns));
  484.   END;
  485.  
  486. (* ------------------------------------------------------ *)
  487. (* Lädt aus einer ausgelagerten Datei den Teil von "y1"   *)
  488. (* bis "y2", sofern möglich.                              *)
  489. (* ------------------------------------------------------ *)
  490.   PROCEDURE BufferObj.LoadPart(y1, y2 : INTEGER);
  491.   VAR
  492.     i, j, No : INTEGER;
  493.  
  494.     PROCEDURE SearchSave(BegCol, EndCol, Max : INTEGER;
  495.                          VAR Counter         : INTEGER);
  496.     VAR
  497.       i : INTEGER;
  498.     BEGIN
  499.       i := BegCol;
  500.       WHILE NOT (i > EndCol) AND
  501.             NOT (Counter >= Max) DO BEGIN
  502.         IF TextBuf^[i] <> NIL THEN BEGIN
  503.           SaveLine(i);  Inc(Counter);
  504.           FreeMem(TextBuf^[i], 2 * Succ(Columns));
  505.           TextBuf^[i] := NIL
  506.         END;
  507.         Inc(i);
  508.       END;
  509.     END;
  510.  
  511.   BEGIN  { LoadPart }
  512.     IF XYInBuf(1, y1) AND XYInBuf(1, y2) AND AllSaved AND
  513.        (BufErrorL1 <> BufFileErr) THEN BEGIN
  514.       No := 0;  j  := 0;
  515.       FOR i := y1 TO y2 DO
  516.         IF TextBuf^[i] = NIL THEN Inc(No);
  517.       SearchSave(1, y1, No, j);
  518.       SearchSave(Succ(y2), Lines, No, j);
  519.       i  := y1;  No := 0;
  520.       WHILE NOT (i > y2) AND NOT (No >= j) DO BEGIN
  521.         IF TextBuf^[i] = NIL THEN BEGIN
  522.           LoadLine (i, TempLines[LPTL]^);
  523.           Inc(No);
  524.           GetMem(TextBuf^[i], 2 * Succ(Columns));
  525.           Move(TempLines[LPTL]^, TextBuf^[i]^,
  526.                2 * Succ(Columns));
  527.         END;
  528.         Inc(i);
  529.       END;
  530.     END;
  531.   END;
  532.  
  533. (* ------------------------------------------------------ *)
  534. (* Wenn "SaveData" FALSE ist, wird die temporäre Datei ge-*)
  535. (* löscht, ansonsten alles nochmal gespeichert, und, wenn *)
  536. (* "EndName" <> '' ist, die Datei in "EndName" umbenannt. *)
  537. (* ACHTUNG: Nur am Ende von Done aus aufrufen!            *)
  538. (* ------------------------------------------------------ *)
  539.   PROCEDURE BufferObj.CloseFile;
  540.   BEGIN
  541.     IF AllSaved THEN BEGIN
  542.       IF SaveData THEN SaveFrom(0);
  543.       {$I-}
  544.       Close(f);
  545.       {$I+}
  546.       BufDosErr := IOResult;
  547.       IF (BufDosErr <> 0) THEN
  548.         ErrorHandling(BufFileErr)
  549.       ELSE BEGIN
  550.         IF (NOT SaveData) AND (EndName = '') THEN
  551.           Erase(f)       { wenn nicht retten, dann löschen }
  552.         ELSE IF EndName <> '' THEN
  553.           Rename(f, EndName)             { oder umbenennen }
  554.             { ACHTUNG: Es darf keine Datei mit dem Namen   }
  555.             { "EndName" existieren, sonst bleibt die Umbe- }
  556.             { nennung erfolglos.                           }
  557.       END;
  558.     END;
  559.   END;
  560.  
  561. (* ------------------------------------------------------ *)
  562. (* Fügt an der Position "y" eine Anzahl von Zeilen ein.   *)
  563. (* "y" kann einen Wert von 0 bis "Lines" annehmen. Die    *)
  564. (* neuen Zeilen werden von y+1 an abwärts eingefügt.      *)
  565. (* Beim Versucht, mehr Zeilen einzufügen, als "MaxLines"  *)
  566. (* verkraftet, wird "No" eingeschränkt.                   *)
  567. (* ------------------------------------------------------ *)
  568.   PROCEDURE BufferObj.InsLines(y, No : INTEGER);
  569.   VAR
  570.     OldLines, i : INTEGER;
  571.   BEGIN
  572.     IF (y >= 0) AND (y <= Lines) THEN BEGIN
  573.       IF y + No > MaxLines THEN No := MaxLines - y;
  574.       OldLines := Lines;
  575.       SetMaxLines (No);
  576.       IF BufErrorL1 <> 0 THEN BEGIN
  577.         SetMaxLines(-(Lines-OldLines));
  578.         Exit;
  579.       END;
  580.       LoadLine(Lines, TempLines[InsTL]^);
  581.       FOR i := Lines DOWNTO y+No DO CopyLine(i-No, i);
  582.       FOR i := y TO Pred(y+No) DO
  583.         SaveNewLine(i, TempLines[InsTL]^, FALSE);
  584.     END ELSE
  585.       ErrorHandling(BufInsLineErr);
  586.   END;
  587.  
  588. (* ------------------------------------------------------ *)
  589. (* Kopiert eine Zeile von "Source" nach "Dest" um.        *)
  590. (* ------------------------------------------------------ *)
  591.   PROCEDURE BufferObj.CopyLine(Source, Dest : INTEGER);
  592.   BEGIN
  593.     IF XYInBuf(1, Source) AND XYInBuf(1, Dest) THEN BEGIN
  594.       LoadLine(Source, TempLines[CopyTL]^);
  595.       SaveNewLine(Dest, TempLines [CopyTL]^, FALSE);
  596.     END;
  597.   END;
  598.  
  599. (* ------------------------------------------------------ *)
  600. (* Löscht, angefangen mit der Zeile "y", "No" Zeilen      *)
  601. (* aus dem Puffer bzw der Datei.                          *)
  602. (* ------------------------------------------------------ *)
  603.   PROCEDURE BufferObj.DelLines(y, No : INTEGER);
  604.   VAR
  605.     i : INTEGER;
  606.   BEGIN
  607.     IF XYInBuf(1, y) AND (No > 0) THEN BEGIN
  608.       IF y + No > Succ(Lines) THEN  No := Succ(Lines - y);
  609.       FOR i := Succ(y+No) TO Lines DO CopyLine(i, i-No);
  610.       SetMaxLines(-No);
  611.     END ELSE
  612.       ErrorHandling(BufDelLineErr);
  613.   END;
  614.  
  615. (* ------------------------------------------------------ *)
  616. (* Schreibt an "x", "y" den String "str" mit dem Attribut *)
  617. (* "Attr" in den Puffer.                                  *)
  618. (* ------------------------------------------------------ *)
  619.   PROCEDURE BufferObj.WriteStrXY(x, y : INTEGER;
  620.                                  Str  : STRING);
  621.   VAR
  622.     s1, s2  : STRING;
  623.     cp, y2  : INTEGER;
  624.     LNo     : BYTE;
  625.     OnePlus : BOOLEAN;
  626.  
  627.     (* -------------------------------------------------- *)
  628.     (* Erledigt folgende Vorgänge:                        *)
  629.     (* Länge retten; kopieren von "Str" nach "Line"; neue *)
  630.     (* Länge berechnen; formatieren von "Line".           *)
  631.     PROCEDURE WriteOneLine(Str      : STRING;
  632.                            x, y     : INTEGER;
  633.                            VAR Line : OneLine);
  634.     VAR
  635.       i, OldLength, NewLength : INTEGER;
  636.     BEGIN
  637.       IF KillWrite THEN GetNewLine(Attr, Line);
  638.       CASE LineForm OF
  639.         Center : x := Columns DIV 2 - Length(Str) DIV 2;
  640.         Right  : x := Columns - Length(Str);
  641.       END;
  642.       OldLength := Line[0];            { alte Länge retten }
  643.       Attr := BufCol + BufBackCol * 16;
  644.       FOR i := 1 TO Length(Str) DO              { Kopieren }
  645.       Line[Pred(x+i)] := Ord(Str[i]) + Attr SHL 8;
  646.       NewLength := Pred(x + Length(s1));
  647.       IF (OldLength > NewLength) AND
  648.          NOT KillLineRest THEN NewLength := OldLength;
  649.       Line[0] := NewLength;
  650.       FormatLine(Line);
  651.       SaveNewLine(y, Line, FALSE)          { und speichern }
  652.     END;
  653.  
  654.   BEGIN  { WriteStringXY }
  655.     IF y = Succ(Lines) THEN BEGIN
  656.       OnePlus := TRUE;
  657.       IF NOT AllSaved THEN SetMaxLines(1)
  658.                       ELSE Inc (Lines)
  659.     END ELSE
  660.       OnePlus := FALSE;
  661.     IF NOT XYInBuf(1, y) THEN BEGIN
  662.       ErrorHandling(BufWriteStrErr);  Exit;
  663.     END;
  664.     IF x > Columns THEN BEGIN
  665.       x := 1; Inc(y);
  666.       IF NOT XYInBuf(1, y) THEN     { neue Zeile benötigt? }
  667.         SetMaxLines (1);
  668.       IF (BufErrorL1 = BufDiskFull) OR
  669.          (BufErrorL1 = BufFileErr) THEN Exit;
  670.     END;
  671.     IF TextBuf^[y] = NIL THEN BEGIN
  672.       IF KillWrite OR OnePlus THEN
  673.         GetNewLine (Attr, TempLines[WrtStrTL]^)
  674.       ELSE
  675.         LoadLine(y, TempLines[WrtStrTL]^);
  676.       IF BufErrorL1 = BufFileErr THEN Exit;
  677.     END ELSE
  678.       LoadLine(y, TempLines[WrtStrTL]^);
  679.     s2  := '';  Lno := 1;
  680.     IF x + Length(Str) > Columns THEN BEGIN
  681.       cp := GetCutPos(Str, x);
  682.       IF cp = 0 THEN  { Falls keine Umbruchstelle gefunden }
  683.         cp := Succ(Columns-x);      { wird, "abschneiden"  }
  684.       s1 := Copy(Str, 1, cp);
  685.       s2 := Copy(Str, cp+1, Length(Str)-cp);
  686.       IF NOT (LineEnd = CutEnd) THEN Lno := 2;
  687.       IF Length(s2) > Columns THEN S2[0] := Chr(Columns);
  688.     END ELSE
  689.       s1 := Str;
  690.     WriteOneLine(s1, x, y, TempLines[WrtStrTL]^);
  691.     IF LNo > 1 THEN BEGIN
  692.       y2 := Succ(y);
  693.       IF NOT XYInBuf(1, y2) THEN BEGIN
  694.         SetMaxLines(1);
  695.         IF (BufErrorL1 = BufDiskFull) OR
  696.            (BufErrorL1 = BufFileErr) THEN Exit;
  697.       END;
  698.       LoadLine(y2, TempLines[WrtStrTL]^);
  699.       WriteOneLine(s2, 1, y2, TempLines[WrtStrTL]^);
  700.     END;
  701.     IF MoveBufCur THEN BEGIN     { Cursor analog bewegen ? }
  702.       BufCurY := Pred(BufCurY + LNo);
  703.       IF LNo > 1 THEN
  704.         BufCurX := Length(s2)
  705.       ELSE
  706.         BufCurX := x + Length(s1);
  707.       IF LineFeed THEN BEGIN
  708.         IF y = Lines THEN SetMaxLines(1);
  709.         IF NOT (BufErrorL1 = BufDiskFull) AND
  710.            NOT (BufErrorL1 = BufFileErr) THEN BEGIN
  711.           BufCurX := 1;  Inc(BufCurY);
  712.         END;
  713.       END;
  714.     END;
  715.   END;
  716.  
  717. (* ------------------------------------------------------ *)
  718. (* Schreibt "Str" an die aktuelle Cursorposition.         *)
  719. (* ------------------------------------------------------ *)
  720.   PROCEDURE BufferObj.WriteStr(Str : STRING);
  721.   BEGIN
  722.     WriteStrXY(BufCurX, BufCurY, Str);
  723.   END;
  724.  
  725. (* ------------------------------------------------------ *)
  726. (* Hier nur als Dummy, da eine Zeile nicht speziell for-  *)
  727. (* matiert werden muß. Die Prozedur könnte zum Beispiel   *)
  728. (* zum Formatieren von Blöcken eingesetzt werden.         *)
  729. (* ------------------------------------------------------ *)
  730.   PROCEDURE BufferObj.FormatLine(VAR Line : OneLine);
  731.   BEGIN
  732.   END;
  733.  
  734. (* ------------------------------------------------------ *)
  735. (* Errechnet die Position des letzten Wortes in einem     *)
  736. (* String. Ein Wortende wird von "x" an abwärts gesucht.  *)
  737. (* ACHTUNG: Keine Bereichsüberprüfung von "x"!            *)
  738. (* ------------------------------------------------------ *)
  739.   FUNCTION BufferObj.GetLastWord(Str : STRING;
  740.                                  x   : INTEGER) : INTEGER;
  741.   BEGIN
  742.     Inc(x);
  743.     REPEAT
  744.       Dec(x);
  745.     UNTIL (Pos(Str[x], WordEndChars) > 0) OR (x < 1);
  746.     IF Pos(Str[x], WordEndChars) > 0 THEN
  747.       GetLastWord := x
  748.     ELSE
  749.       GetLastWord := 0;
  750.   END;
  751.  
  752. (* ------------------------------------------------------ *)
  753. (* Errechnet die "Schnittstelle" in einem String, der     *)
  754. (* über zwei Zeilen gehen soll. Berücksichtigt wird hier  *)
  755. (* "LineEnd", das angibt, wie eine Zeile beendet wird.    *)
  756. (* ------------------------------------------------------ *)
  757.   FUNCTION BufferObj.GetCutPos(Str : STRING;
  758.                                x   : INTEGER) : INTEGER;
  759.   VAR
  760.     cp : INTEGER;
  761.   BEGIN
  762.     CASE LineEnd OF
  763.       CutPrevWord : cp := GetLastWord(Str, Columns - x + 2);
  764.       WriteOver,
  765.       CutEnd      : cp := Succ(Columns - x);
  766.     END;
  767.     GetCutPos := cp;
  768.   END;
  769.  
  770. (* ------------------------------------------------------ *)
  771. (* Gibt die Länge der durch "y" spezifierten Zeile zurück *)
  772. (* Ist "y" nicht im Pufferbereich, ist der Wert -1.       *)
  773. (* ------------------------------------------------------ *)
  774.   FUNCTION BufferObj.GetLineLength(y : INTEGER) : INTEGER;
  775.   BEGIN
  776.     IF XYInBuf(1, y) THEN BEGIN
  777.       LoadLine(y, TempLines[GetLLTL]^);
  778.       GetLineLength := TempLines[GetLLTL]^[0]
  779.     END ELSE
  780.       GetLineLength := -1;
  781.   END;
  782.  
  783. (* ------------------------------------------------------ *)
  784. (* Wandelt Line in einen String um. Ist "y" länger als    *)
  785. (* 255 Zeichen, so wird der Rest ignoriert.               *)
  786. (* ------------------------------------------------------ *)
  787.   FUNCTION BufferObj.Convert2Str(y : INTEGER) : STRING;
  788.   VAR
  789.     i   : INTEGER;
  790.     Str : STRING;
  791.   BEGIN
  792.     i   := 1;  Str := '';
  793.     LoadLine(y, TempLines[ConvTL]^);
  794.     IF TempLines[ConvTL]^[0] <> 0 THEN
  795.       REPEAT
  796.         Str := Str + Chr(Lo(TempLines[ConvTL]^[i]));
  797.         Inc(i);                { das i.te Zeichen kopieren }
  798.       UNTIL (i > TempLines[ConvTL]^[0]) OR (i > 255);
  799.     Convert2Str := Str;
  800.   END;
  801.  
  802. (* ------------------------------------------------------ *)
  803. (* Setzt die Schreibfarben für den Buffer neu.            *)
  804. (* ------------------------------------------------------ *)
  805.   PROCEDURE BufferObj.SetWriteColor(Col, BackCol : BYTE);
  806.   BEGIN
  807.     BufCol := Col;     BufBackCol := BackCol;
  808.     Attr   := BufCol + BufBackCol * 16;
  809.   END;
  810.  
  811. (* ------------------------------------------------------ *)
  812. (* Ändert im Pufferbereich x1-x2, y1-y2 die Farben in die *)
  813. (* durch "NewCol" und "NewBackCol" angegebenen.           *)
  814. (* ------------------------------------------------------ *)
  815.   PROCEDURE BufferObj.ChangeColor(x1, y1, x2, y2 : INTEGER;
  816.                                   NewCol,
  817.                                   NewBackCol     : BYTE);
  818.   VAR
  819.     x, y, NewAttr : INTEGER;
  820.   BEGIN
  821.     IF XYInBuf(x1, y1) AND XYInBuf(x2, y2) AND
  822.        (x2 >= x1) AND (y2 >= y1) THEN BEGIN
  823.       NewAttr := NewCol + NewBackCol * 16;
  824.       FOR y := y1 TO y2 DO BEGIN
  825.         LoadLine(y, TempLines [TL]^);
  826.         FOR x := x1 TO x2 DO
  827.           TempLines[TL]^[x] :=
  828.                 Lo(TempLines[TL]^[x]) + WORD(NewAttr SHL 8);
  829.         SaveNewLine(y, TempLines[TL]^, FALSE);
  830.       END;
  831.     END;
  832.   END;
  833.  
  834. (* ------------------------------------------------------ *)
  835. (* Setzt den Puffer-Cursor neu.                           *)
  836. (* ------------------------------------------------------ *)
  837.   PROCEDURE BufferObj.SetBufCursor(x, y : INTEGER);
  838.   BEGIN
  839.     IF XYInBuf(x, y) THEN BEGIN
  840.       BufCurX := x;  BufCurY := y;
  841.     END;
  842.   END;
  843.  
  844. (* ------------------------------------------------------ *)
  845. (* Gibt die Farbe des Zeichens mit der Position x/y im    *)
  846. (* Puffer zurück.                                         *)
  847. (* ------------------------------------------------------ *)
  848.   PROCEDURE BufferObj.GetBufXYColors(x, y    : INTEGER;
  849.                                      VAR Col,
  850.                                      BackCol : BYTE);
  851.   VAR
  852.     a : BYTE;
  853.   BEGIN
  854.     IF XYInBuf(x, y) THEN BEGIN
  855.       LoadLine(y, TempLines[TL]^);
  856.       a := Hi(TempLines[TL]^[x]);
  857.       Col := a AND 15;  BackCol := a AND 112 DIV 16
  858.     END;
  859.   END;
  860.  
  861. (* ------------------------------------------------------ *)
  862. (* Gibt das Attribut der Position x/y zurück.             *)
  863. (* ------------------------------------------------------ *)
  864.   FUNCTION BufferObj.GetBufXYAttr(x, y: INTEGER) : BYTE;
  865.   BEGIN
  866.     IF XYInBuf(x, y) THEN BEGIN
  867.       LoadLine(y, TempLines[TL]^);
  868.       GetBufXYAttr := Hi(TempLines[TL]^[x]);
  869.     END;
  870.   END;
  871.  
  872. (* ------------------------------------------------------ *)
  873. (* Prüft, ob die übergebenen Koordinaten im Pufferberich  *)
  874. (* sind.                                                  *)
  875. (* ------------------------------------------------------ *)
  876.   FUNCTION BufferObj.XYInBuf(x, y : INTEGER) : BOOLEAN;
  877.   BEGIN
  878.     IF (x >= 1) AND (y >= 1) AND (x <= Columns) AND
  879.        (y <= Lines) THEN
  880.       XYInBuf := TRUE
  881.     ELSE BEGIN
  882.       XYInBuf := FALSE;
  883.       ErrorHandling(BufCheckXYErr);
  884.     END;
  885.   END;
  886.  
  887. (* ------------------------------------------------------ *)
  888. (* Gibt den benutzten Speicher frei.                      *)
  889. (* ------------------------------------------------------ *)
  890.   DESTRUCTOR BufferObj.Done;
  891.   VAR
  892.     i : INTEGER;
  893.   BEGIN
  894.     CloseFile;
  895.     IF TextBuf <> NIL THEN BEGIN
  896.       FOR i := 1 TO Lines DO
  897.         IF TextBuf^[i] <> NIL THEN BEGIN
  898.           FreeMem(TextBuf^[i], 2 * Succ(Columns));
  899.           TextBuf^[i] := NIL;
  900.         END;
  901.     END;
  902.     IF InfoLine <> NIL THEN BEGIN
  903.       FreeMem(InfoLine, 2 * Succ(Columns));
  904.       InfoLine := NIL;
  905.     END;
  906.     FOR i := CopyTL TO TL DO
  907.       IF TempLines[i] <> NIL THEN
  908.         FreeMem(TempLines[i], 2 * Succ(Columns));
  909.     IF TextBuf <> NIL THEN BEGIN
  910.       FreeMem(TextBuf, 2 * Succ(MaxLines));
  911.       TextBuf := NIL;
  912.     END;
  913.   END;
  914.  
  915. (* ------------------------------------------------------ *)
  916. (* Eigene Fehlerroutine (S.113 im Handbuch zu 5.5).       *)
  917. (* Wenn eine eigene Fehlerroutine im Fehlerfall 1 zurück- *)
  918. (* gibt, erscheint nach dem Aufruf von "New" oder         *)
  919. (* "GetMem" ein NIL-Pointer, wenn ein Fehler aufgetreten  *)
  920. (* ist, anstatt das Programm abzubrechen.                 *)
  921. (* ------------------------------------------------------ *)
  922. {$F+}
  923.   FUNCTION HeapFunc(Size : WORD) : INTEGER;
  924. {$F-}
  925.   BEGIN
  926.     HeapFunc := 1;
  927.   END;
  928.  
  929. (* ------------------------------------------------------ *)
  930. (* Initialisierungsteil der Unit. "HeapError" wird auf    *)
  931. (* "HeapFunc" gesetzt.                                    *)
  932. (* ------------------------------------------------------ *)
  933. BEGIN
  934.   HeapError := @HeapFunc;
  935.   FOR i := CopyTL TO TL DO TempLines[i] := NIL
  936. END.
  937. (* ------------------------------------------------------ *)
  938. (*                Ende von BUFFER5.PAS                    *)
  939.  
  940.