Turbo Toolbox/Turbo_Toolbox.iso/1991/09_10/praxis/edit.pas

Pascal/Delphi Source File | 1991-07-18 | 17.8 KB | 517 lines

(* ------------------------------------------------------ *)
(*                      EDPAS.PAS                         *)
(*          Kleiner Rumpfeditor in Turbo Pascal           *)
(*                   Turbo Pascal 6.0                     *)
(*                   (c) 1991 TOOLBOX                     *)
(* ------------------------------------------------------ *)
{$A+,B-,D-,F-,G-,I-,O-,R-,S-,V-,X+}
{$M 8192,0,655360}

PROGRAM EDPAS;
USES Dos, Crt;
TYPE
  Str80      = STRING[80];            { für eine Textzeile }
  StrPtr     = ^Str80;        { Pointer auf eine Textzeile }
  ScreenCell = RECORD          { für direktes Schreiben in }
                  ch : CHAR; Attr : BYTE;
               END;               { den Bildschirmspeicher }
  ScreenRec  = ARRAY[1..25,1..80] OF ScreenCell;{ VideoRAM }
CONST
  InsertMode : BOOLEAN = TRUE;             { Insert aktiv? }
                                 { Positionen in Infozeile }
  PosPos = 1; NamePos = 11; InsPos = 28; TextMaxY = 24;
  ErrorMessage : ARRAY [1..5] OF STRING =
   ('Datei nicht gefunden', 'Lesefehler',
    'Datei kann nicht geschrieben werden',
    'Laufwerk nicht bereit',
    'Text paßt nicht in Arbeitsspeicher');
VAR
  Key,               { Taste oder erweiterter Tastaturcode }
  TextLine,        { Nr. der gerade bearbeiteten Textzeile }
  FirstOnScreen,       { Nr. der obersten Zeile auf Screen }
  MaxLine : WORD;              { Nr. der letzten Textzeile }
  FileName,                                { Name Texdatei }
  NextFile : STRING;              { Name zu ladender Datei }
  TextFile : TEXT;                 { File-Handle Textdatei }
  Lines : ARRAY[1..15600] OF StrPtr;            { der Text }
  ScreenID : BYTE ABSOLUTE $040:$049;           { CGA/HGC? }
  Screen : ^ScreenRec;                { Bildschirmspeicher }
  IOError : BOOLEAN;      { Flag für Dateifehlerbehandlung }
  InfoBuffer : ARRAY[1..80] OF WORD; { Puffer f. Infozeile }
  TextCol : BYTE;                      { Spalte Textcursor }
  TextColor, ErrorColor, InfoColor : BYTE;        { Farben }

{$F+}                     { für Errorhandling Heapspeicher }
FUNCTION HeapFunc(Size : WORD) : INTEGER;
{$F-}          { ermöglicht das Abfangen von Heap-Fehlern; }
BEGIN          { diese Funktion muß in jedem Fall explizit }
  HeapFunc := 1;                     { installiert werden! }
END;  { HeapFunc }

FUNCTION GetKey : WORD;  { auf Taste warten und Auswertung }
VAR ch1, ch2 : CHAR;
BEGIN
  REPEAT UNTIL KeyPressed;
  ch1 := ReadKey;
  IF ch1 = #0 THEN BEGIN       { erweiterter Tastaturcode: }
    ch2 := ReadKey;   { 2. Taste erfragen, Wert in Hi-Byte }
    GetKey := BYTE(ch2) * 256 + BYTE(ch1);    { schreiben; }
  END ELSE GetKey := BYTE(ch1);     { sonst Rückgabe ASCII }
END;  { GetKey }

PROCEDURE WriteLine(Nr : WORD);           { Zeile anzeigen }
VAR l, n, y : BYTE;
BEGIN
  y := Nr - FirstOnScreen + 1; l := Length(Lines[Nr]^);
  IF Nr <= MaxLine THEN BEGIN
    FOR n := 1 TO 80 DO BEGIN
      Screen^[y, n].Attr := TextColor;
      IF n <= l THEN Screen^[y, n].ch := Lines[Nr]^[n]
                ELSE Screen^[y, n].ch := #0;
    END;
  END ELSE
    FOR n := 1 TO 80 DO BEGIN
      Screen^[y, n].Attr := TextColor;
      Screen^[y, n].ch := #0;
    END;
END;  { WriteLine }

PROCEDURE WriteInfoLine(Msg : STRING);         { Infozeile }
BEGIN
  TextAttr := InfoColor; GotoXY(1, 25); Write(Msg); ClrEol;
END;  { WriteInfoline }

PROCEDURE SaveInfoline;                { Infozeile puffern }
BEGIN
  Move(Screen^[25, 1], InfoBuffer, SizeOf(InfoBuffer));
END;  { SaveInfoline }

PROCEDURE RestoreInfoline;        { Infozeile restaurieren }
BEGIN
  Move(InfoBuffer, Screen^[25, 1], SizeOf(InfoBuffer));
END;  { RestoreInfoline }

PROCEDURE QuitProgram;                { Programm verlassen }
BEGIN
  WriteInfoLine(' Programm beenden (J/N) ?');
  REPEAT
    IF UpCase(ReadKey) = 'J' THEN BEGIN
      TextMode(LastMode); TextAttr := LightGray;
      ClrScr; Halt;
    END ELSE BEGIN
      RestoreInfoLine; Exit;
    END;
  UNTIL FALSE;
END;  { QuitProgram }

PROCEDURE ShowError(Nr : BYTE; Fatal : BOOLEAN);
BEGIN                             { Fehlermeldung ausgeben }
  SaveInfoline; GotoXY(1, 25); TextAttr := ErrorColor;
  Write(ErrorMessage[Nr], ' - Taste...'); ClrEol; Write(^G);
  REPEAT UNTIL ReadKey > '';
  RestoreInfoline;
  IF Fatal THEN QuitProgram;
END;  { ShowError }

PROCEDURE Scroll(Val : INTEGER);  { Text anzeigen/scrollen }
VAR n : WORD;
BEGIN
  IF MaxLine = 0 THEN Exit;
  IF FirstOnScreen + Val < 1 THEN BEGIN
    FirstOnScreen := 1; TextLine := 1;
  END ELSE BEGIN
    FirstOnScreen := FirstOnScreen + Val;
    TextLine := TextLine + Val;
    IF FirstOnScreen > MaxLine THEN
      FirstOnScreen := MaxLine;
    IF TextLine > MaxLine THEN TextLine := MaxLine;
  END;
  TextAttr := TextColor;
  IF Abs(Val) <> 1 THEN
    FOR n := FirstOnScreen TO FirstOnScreen + TextMaxY - 1
    DO BEGIN WriteLine(n);
    END
  ELSE BEGIN           { eine Zeile scrollen: Move-Befehle }
    CASE Val OF               { sorgen für Geschwindigkeit }
      1  : BEGIN                       { eine Zeile runter }
             Move(Screen^[2, 1], Screen^[1, 1],
                  (TextMaxY - 1) * 160);
             WriteLine(FirstOnScreen + TextMaxY - 1);
           END;
      -1 : BEGIN                        { ...und eine rauf }
             Move(Screen^[1, 1], Screen^[2, 1],
                  (TextMaxY - 1) * 160);
             WriteLine(FirstOnScreen);
           END;
    END;
  END;
END;  { Scroll }

PROCEDURE GetNewLine;    { holt Heap für neue letzte Zeile }
BEGIN
  Inc(MaxLine); New(Lines[MaxLine]);
  IF Lines[MaxLine] = NIL THEN ShowError(5, TRUE);
END;  { GetNewLine }

PROCEDURE ReleaseLine;  { Heap der letzten Zeile freigeben }
BEGIN
  Dispose(Lines[MaxLine]); Dec(MaxLine);
END;  { ReleaseLine }

PROCEDURE InsertLine(Nr : WORD);          { Zeile einfügen }
VAR n : WORD;
BEGIN
  GetNewLine;
  FOR n := MaxLine - 1 DOWNTO Nr DO
    Lines[n + 1]^ := Lines[n]^;
  Lines[Nr]^ := '';
END;  { InsertLine }

PROCEDURE DeleteLine(Nr : WORD);           { Zeile löschen }
VAR n : WORD;
BEGIN
  IF MaxLine > 0 THEN BEGIN
    FOR n := Nr TO MaxLine - 1 DO
      Lines[n]^ := Lines[n + 1]^;
    ReleaseLine;
  END;
END;  { DeleteLine }

PROCEDURE ShowInsert;             { Insert-Status anzeigen }
BEGIN
  TextAttr := InfoColor; GotoXY(InsPos, 25);
  IF InsertMode THEN Write('INS')
                ELSE Write('OVR');
END;  { ShowInsert }

PROCEDURE ShowPosition;  { Cursorposition x und y anzeigen }
BEGIN
  TextAttr := InfoColor; GotoXY(PosPos, 25);
  Write(TextLine:5, ':', TextCol:2);
END;  { ShowPosition }

PROCEDURE ShowName;                  { Dateinamen anzeigen }
VAR D : DirStr; N : NameStr; E : ExtStr;
BEGIN
  FSplit(FileName, D, N, E); TextAttr := InfoColor;
  GotoXY(NamePos, 25); Write(N + E : 12);
END;  { ShowName }

PROCEDURE ToggleInsert;          { Insert-Modus umschalten }
BEGIN
  InsertMode := NOT InsertMode; ShowInsert;
END;  { ToggleInsert }

PROCEDURE InitEmptyText;   { Initialisierung "leerer" Text }
BEGIN
  MaxLine := 0; GetNewLine; Lines[1]^ := '';
  FirstOnScreen := 1; TextLine := 1; TextCol := 1;
END;  { InitEmptyText }

PROCEDURE CheckIO;                { prüft Dateioperationen }
VAR IOErrorNr : WORD;
BEGIN
  IOErrorNr := IOResult; IOError := (IOErrorNr <> 0);
  CASE IOErrorNr OF
    2, 3, 15      : ShowError(1, FALSE);
    100, 154, 158 : ShowError(2, FALSE);
    5, 12, 101    : ShowError(3, FALSE);
    152           : ShowError(4, FALSE);
  END;
END;  { CheckIO }

PROCEDURE LoadFile(Name : STRING);            { Text laden }
VAR n : WORD;
BEGIN
  FileMode := 0;
  {$I-} Assign(TextFile, Name); {$I+}
  CheckIO;
  IF IOError THEN BEGIN InitEmptyText; Exit; END;
  {$I-} Reset(TextFile); {$I+}
  CheckIO;
  IF IOError THEN BEGIN
    IF MaxLine = 0 THEN InitEmptyText;
    Exit;
  END;
  n := 0; MaxLine := 0; SaveInfoline;
  WriteInfoline('Lade Datei ' + Name + '...');
  WHILE NOT EOF(TextFile) DO BEGIN
    GetNewLine; ReadLn(TextFile, Lines[MaxLine]^);
  END;
  Close(TextFile); RestoreInfoline;
  FirstOnScreen := 1; TextLine := 1; TextCol := 1;
  Scroll(0); ShowName;
END;  { LoadFile }

PROCEDURE SaveFile(Name : STRING);          { Text sichern }
VAR n : WORD;
BEGIN
  {$I-} Assign(TextFile, Name); {$I+}
  CheckIO;
  IF IOError THEN Exit;
  {$I-} ReWrite(TextFile); {$I+}
  CheckIO;
  IF IOError THEN Exit;
  SaveInfoline;
  WriteInfoline('Speichere Datei ' + Name + '...');
  FOR n := 1 TO MaxLine DO BEGIN
    WriteLn(TextFile, Lines[n]^); CheckIO;
    IF IOError THEN BEGIN
      RestoreInfoline; Exit;
    END;
  END;
  Close(TextFile); RestoreInfoline;
END;  { SaveFile }

PROCEDURE AddStr(VAR Str : STRING; Len : BYTE);
VAR n : BYTE;          { String mit Leerzeichen verlängern }
BEGIN
  FOR n := Length(Str) TO Pred(Len) DO Str := Str + #32;
END;  { AddStr }

FUNCTION UpString(s : STRING) : STRING;   { wandelt String }
VAR n : BYTE;                          { in Großbuchstaben }
BEGIN
  FOR n := 1 TO Length(s) DO s[n] := UpCase(s[n]);
  UpString := s;
END;  { UpString }

FUNCTION GetParams : STRING;    { Kommandozeilenauswertung }
VAR s : STRING;
BEGIN
  IF ParamCount = 0 THEN s := '' ELSE s := ParamStr(1);
  GetParams := UpString(s);
END;  { GetParams }

PROCEDURE EditLine(y : WORD; x : BYTE; ch : CHAR);
BEGIN                                    { Zeile editieren }
  IF ch IN [#32..#255] THEN BEGIN
    AddStr(Lines[y]^, x - 1);
    IF InsertMode THEN BEGIN            { Zeichen einfügen }
      Insert(ch, Lines[y]^, x);
      IF BYTE(Lines[y]^[0]) > 80 THEN Lines[y]^[0] := #80;
    END ELSE Lines[y]^[x] := ch;   { Zeichen überschreiben }
    WriteLine(y);
    IF TextCol < 80 THEN Inc(TextCol);
  END;
END;  { EditLine }

FUNCTION GetFileName(Msg : STRING) : STRING;
VAR s : STRING; n : BYTE;      { Eingabe eines Dateinamens }
BEGIN
  SaveInfoline; TextAttr := InfoColor;
  Window(1, 25, 80, 25);
  GotoXY(1, 25); ClrEol; Write(Msg);
  ReadLn(s); s := UpString(s); GetFilename := s;
  RestoreInfoline; Window(1, 1, 80, 25);
END;  { GetFilename }

PROCEDURE Edit;                            { Hauptprozedur }
            { es folgen: diverse lokale Prozeduren. Voilá: }
PROCEDURE HelpScreen;                     { Hilfe anzeigen }
VAR ScreenBuf : ScreenRec;
BEGIN
  Move(Screen^[1, 1], ScreenBuf, SizeOf(ScreenBuf));
  TextAttr := InfoColor; Window(20, 6, 61, 18); ClrScr;
  WriteLn(' Spezielle Befehle des toolbox-Editors:');
  WriteLn(' --------------------------------------');
  WriteLn;
  WriteLn('          <F2>    Sichern');
  WriteLn('          <F3>    Laden');
  WriteLn('    <Alt>-<F2>    Sichern als');
  WriteLn(' <Ctrl>-<Home>    Textanfang');
  WriteLn('  <Ctrl>-<End>    Textende');
  WriteLn('         <Ins>    Einfügen/Überschreiben');
  WriteLn('    <Ctrl>-<N>    Zeile einfügen');
  WriteLn('    <Ctrl>-<Y>    Zeile löschen');
  WriteLn;
  Write('          weiter mit beliebiger Taste...');
  REPEAT UNTIL ReadKey > '';
  WHILE KeyPressed DO ReadKey;
  Move(ScreenBuf, Screen^[1, 1], SizeOf(ScreenBuf));
  Window(1, 1, 80, 25);
END;  { HelpScreen }

PROCEDURE DeleteKey;                         { Taste <Del> }
VAR l1, l2 : BYTE;
BEGIN
  l1 := Length(Lines[TextLine]^);
  IF TextLine + 1 <= MaxLine THEN
    l2 := Length(Lines[TextLine + 1]^);
  IF TextCol <= l1 THEN BEGIN { Zchn. unter Cursor löschen }
    Delete(Lines[TextLine]^, TextCol, 1);
    WriteLine(TextLine);
  END ELSE
  BEGIN                            { nächste Zeile anfügen }
    IF TextLine + 1 > MaxLine THEN Exit;
    IF l2 <= 80 - l1 THEN BEGIN      { Zeile paßt komplett }
      Lines[TextLine]^ := Lines[TextLine]^ +
                          Lines[TextLine + 1]^;
      DeleteLine(TextLine + 1);
      Scroll(0);
    END ELSE BEGIN              { Zeile teilweise anhängen }
      Lines[TextLine]^ := Lines[TextLine]^ +
        Copy(Lines[TextLine + 1]^, 1, 80 - l1);
      Delete(Lines[TextLine + 1]^, 1, 80 - l1);
      WriteLine(TextLine); WriteLine(TextLine + 1);
    END;
  END;
END;  { DeleteKey }

PROCEDURE BSKey;                              { Taste <BS> }
VAR l1, l0 : BYTE;
BEGIN
  l1 := Length(Lines[TextLine]^);
  IF TextLine > 1 THEN
    l0 := Length(Lines[TextLine - 1]^);
  IF TextCol > 1 THEN BEGIN  { Zchn. links v.Curs. löschen }
    Delete(Lines[TextLine]^, TextCol - 1, 1);
    Dec(TextCol); WriteLine(TextLine);
  END ELSE
  BEGIN                             { letzte Zeile anfügen }
    IF TextLine = 1 THEN Exit;
    IF l0 <= 80 - l1 THEN BEGIN      { Zeile paßt komplett }
      TextCol := Length(Lines[TextLine - 1]^) + 1;
      Lines[TextLine]^ := Lines[TextLine - 1]^ +
                          Lines[TextLine]^;
      Dec(TextLine); DeleteLine(TextLine); Scroll(0);
    END ELSE
    BEGIN                       { Zeile teilweise anhängen }
      Lines[TextLine - 1]^ := Lines[TextLine - 1]^ +
        Copy(Lines[TextLine]^, 1, 80 - l0);
      Delete(Lines[TextLine]^, 1, 80 - l0);
      WriteLine(TextLine - 1); WriteLine(TextLine);
    END;
  END;
END;  { BSKey }

PROCEDURE EnterKey;                        { Taste <Enter> }
BEGIN
  CASE InsertMode OF
    TRUE :
      BEGIN
        InsertLine(TextLine);
        Lines[TextLine + 1]^ :=
          Copy(Lines[TextLine + 1]^, TextCol,
               Length(Lines[TextLine + 1]^) - TextCol + 1);
        Lines[TextLine]^[0] := CHAR(TextCol - 1);
        TextCol := 1;
        IF TextLine - FirstOnScreen > TextMaxY - 2 THEN
          Scroll(0)
        ELSE BEGIN Inc(TextLine); Scroll(0);
        END;
      END;
    FALSE :
      IF TextLine < MaxLine THEN BEGIN
        TextCol := 1;
        IF TextLine - FirstOnScreen > TextMaxY - 2 THEN
          Scroll(1)
        ELSE Inc(TextLine);
      END ELSE BEGIN GetNewLine; Lines[MaxLine]^ := '';
      END;
  END;
END;  { EnterKey }

PROCEDURE SaveAs;          { Taste <Alt>-<F2>: Sichern als }
BEGIN
  NextFile := GetFilename('Datei sichern als: ');
  IF NextFile > '' THEN BEGIN
    FileName := NextFile; SaveFile(FileName); ShowName;
  END;
END;  { SaveAs }

PROCEDURE LoadTextFile;          { Taste <F3>: Datei laden }
BEGIN
  NextFile := GetFilename('Datei laden: ');
  IF NextFile > '' THEN BEGIN
    LoadFile(NextFile);
    IF NOT IOError THEN BEGIN
      FileName := NextFile; ShowName;
    END;
  END;
END;  { LoadFile }

BEGIN  { Edit }
  REPEAT
    ShowPosition;
    GotoXY(TextCol, TextLine - FirstOnScreen + 1);
    Key := GetKey;
    IF Key < 255 THEN BEGIN        { normaler Tastaturcode }
      CASE Key OF
        8  : BSKey;                                 { <BS> }
        13 : EnterKey;                           { <Enter> }
        14 : BEGIN                            { <Ctrl>-<N> }
               InsertLine(TextLine); Scroll(0);
             END;
        25 : BEGIN                            { <Ctrl>-<Y> }
               DeleteLine(TextLine); Scroll(0);
             END;
        27 : QuitProgram;                          { <Esc> }
      ELSE   EditLine(TextLine, TextCol, CHAR(Key));
      END;
    END ELSE BEGIN              { erweiterter Tastaturcode }
      CASE Hi(Key) OF
        59 : HelpScreen;                            { <F1> }
        60 : SaveFile(FileName);                    { <F2> }
        61 : LoadTextFile;                          { <F3> }
        71 : TextCol := 1;                        { <Home> }
        72 : IF TextLine > 1 THEN                 { <hoch> }
               IF TextLine < FirstOnScreen + 1
               THEN Scroll(-1)
               ELSE Dec(TextLine);
        73 : Scroll(- TextMaxY + 1);              { <PgUp> }
        75 : IF TextCol > 1 THEN Dec(TextCol);   { <links> }
        77 : IF TextCol < 80 THEN Inc(TextCol); { <rechts> }
        79 : BEGIN                                 { <End> }
               TextCol := BYTE(Lines[TextLine]^[0]);
               IF TextCol < 80 THEN Inc(TextCol);
             END;
        80 : IF TextLine < MaxLine THEN         { <runter> }
               IF TextLine - FirstOnScreen > TextMaxY - 2
               THEN Scroll(1)
               ELSE Inc(TextLine);
        81 : Scroll(TextMaxY - 1);                { <PgDn> }
        82 : ToggleInsert;                         { <Ins> }
        83 : DeleteKey;                            { <Del> }
        105: SaveAs;                          { <Alt>-<F2> }
        117: BEGIN                          { <Ctrl>-<End> }
               FirstOnScreen := MaxLine - TextMaxY + 1;
               TextLine := MaxLine; Scroll(0);
             END;
        119: BEGIN                         { <Ctrl>-<Home> }
               TextLine := 1; FirstOnScreen := 1; Scroll(0);
             END;
      END;
    END;
  UNTIL FALSE;
END;  { Edit }

PROCEDURE Init;                { diverse Initialisierungen }
BEGIN
  IF ScreenID = 7 THEN BEGIN       { Grafikkartenerkennung }
    Screen := Ptr($B000, $0000);  { Hercules, der "Starke" }
    TextColor   := 7;                    { normale Schrift }
    ErrorColor  := 240;                  { invers blinkend }
    InfoColor   := 120;                      { invers hell }
  END ELSE BEGIN
    Screen := Ptr($B800, $0000);             { CGA/EGA/VGA }
    TextColor  := Yellow OR Blue SHL 4;
    ErrorColor := Yellow OR LightRed SHL 4;
    InfoColor  := White OR Red SHL 4;
  END;
  TextAttr := TextColor; ClrScr;
  HeapError := @HeapFunc;  { Error-Handling initialisieren }
  WriteInfoline('                                 ' +
                '      toolbox-Editor   <F1> Hilfe');
  MaxLine := 0; ShowInsert; FileName := GetParams;
  IF FileName > '' THEN LoadFile(FileName)
  ELSE InitEmptyText;
  Scroll(0);
END;  { Init }

BEGIN                                      { Hauptprogramm }
  Init; Edit;
END.
(* ------------------------------------------------------ *)
(*                 Ende von EDPAS.PAS                     *)