C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/EDITWIN/EDITWIN.PAS

Pascal/Delphi Source File | 1992-10-23 | 23KB | 802 lines

{$X+}
{**************************************************************}
{                                                              }
{           Saved as: EDITWIN.PAS                              }
{           Language: Turbo Pascal 6                           }
{             Author: Pat Anderson                             }
{            Purpose: Drop in Editor object                    }
{      Last modified: Mon 10-22-92                             }
{                                                              }
{**************************************************************}

unit EditWin;

interface

uses
  Crt,
  Minikit,        { Non-OOP mini-toolkit }
  O_Tbuf,         { OOP text buffer unit }
  EdLine;         { non-OOP line editor }

type
  TStatusProc = procedure;
  TMode = (EditOK, ReadOnly);
  PEditWindow = ^TEditWindow;
  TEditWindow = object
    Header : string;
    LeftX, TopY, RightX, BottomY,
    EditWindowHeight, EditWindowWidth :  byte;
    TopLine, CurrentLine : integer;
    Cursor, Col, Row : byte;
    InsertFlag,
    WindowOpen : boolean;
    SavedScreen : TSavedScreenInfo;
    WindowCoords : TWindowCoords;
    StatusProc : TStatusProc;
    theTextBuffer : PTextBuffer;
    ExitKey : char;
    EditAllowed : boolean;
    FileName : string;
    SaveLine : string;
    constructor Init (Left, Top, Right, Bottom : byte;
                      HeaderMsg : string;
                      TextBuffer : PTextBuffer; Mode : TMode);
    procedure ShowWindow;
    procedure HideWindow;
    procedure SetFileName (Name : string);
    procedure Process;
    function GetFileName : string;
    function GetExitKey : char;
    destructor Done;
  end;

implementation
  var
    SaveAttr : byte;
    StatusX,
    StatusY : byte;
    Line : integer;
    FName : string;

  {$F+}
  procedure UpdateStatus;
    var
      ColStr,
      LineStr,
      StatusText : string;
    begin
      Str (CursorPosition - StartColumn + 1:2, ColStr);
      Str (Line:3, LineStr);
      StatusText := ' Col ' + ColStr + ' Line ' + LineStr + ' ';
      if FName <> '' then
        StatusText := StatusText + '  ' + FName + ' ';
      FastWrite (StatusText, StatusY, StatusX, Edit_Attr);
    end;
  {$F-}

  constructor TEditWindow.Init (Left, Top, Right, Bottom : byte;
                                HeaderMsg : string;
                                TextBuffer : PTextBuffer; Mode : TMode);
    begin
      if HeaderMsg <> '' then
        Header := HeaderMsg
      else Header := '';
      LeftX := Left; TopY := Top;
      RightX := Right; BottomY := Bottom;
      theTextBuffer := TextBuffer;
      if Mode = EditOK then
        EditAllowed := true
      else
        EditAllowed := false;
      FileName := '';
      EditWindowHeight := BottomY - TopY - 1;
      EditWindowWidth := RightX - LeftX - 2;
      TextAttr := Text_Attr;
      TopLine := 1;
      CurrentLine := 1;
      Col := 1;
      Cursor := Col;
      Row := 1;
      InsertFlag := false;
      WindowOpen := false;
    end;

procedure TEditWindow.ShowWindow;
  begin
    SaveScreen (SavedScreen);
    DrawBox (LeftX, TopY, RightX, BottomY, Text_Attr);
    Window (LeftX + 1, TopY + 1, RightX - 1, BottomY - 1);
    ClrScr;
    WindowOpen := true;
  end;

procedure TEditWindow.HideWindow;
  begin
    RestoreScreen (SavedScreen);
    WindowOpen := false;
  end;

procedure TEditWindow.SetFileName (Name : string);
  begin
    FileName := ToUpper (Name);
  end;

procedure TEditWindow.Process;
  var
    UserQuits : boolean;
    Key : char;
    CurrentLineStr : string;
    TitleStr : string;

  procedure RedrawScreen;
    var
      Row : byte;
    begin
      CursorOff;
      Row := 1;
      while Row <= EditWindowHeight do begin
        GotoXY (1, Row); ClrEOL;
        Write (Copy (theTextBuffer^.StringFromArray (TopLine + Row - 1),
               1, EditWindowWidth));
        Inc (Row);
      end;
    end;

  procedure ScrollScreenUp;
    var
      Difference : byte;
    begin
      Difference := CurrentLine - TopLine;
      TopLine := TopLine + EditWindowHeight;
      if TopLine > theTextBuffer^.TotalLines - EditWindowHeight then
        TopLine := theTextBuffer^.TotalLines - EditWindowHeight;
      CurrentLine := TopLine + Difference;

      RedrawScreen;
    end;

  procedure ScrollScreenDown;
    var
      Difference : byte;
    begin
      Difference := CurrentLine - TopLine;
      TopLine := TopLine - EditWindowHeight;
      if TopLine < 1 then
        TopLine := 1;
      CurrentLine := TopLine + Difference;
      RedrawScreen;
    end;

  procedure DeleteLine;
    begin
      SaveLine := theTextBuffer^.StringFromArray (CurrentLine);
      theTextBuffer^.DeleteLineFromArray (CurrentLine);
      RedrawScreen;
    end;

  procedure UndeleteLine;
    var
      OK : boolean;
    begin
      OK := theTextBuffer^.InsertLine (SaveLine, CurrentLine);
      RedrawScreen;
    end;

  procedure TopOfFile;
    begin
      CurrentLine := 1;
      TopLine := 1;
      Row := 1;
      RedrawScreen;
    end;

  PROCEDURE CursorUpOneLine;
    BEGIN
      if CurrentLine > 1 then
        Dec (CurrentLine)
      else
        Exit;

      { Up one line on same screen }
      if Row > 1 then begin
        Dec (Row);
        Exit;
      end;

      { if not room on screen then scroll }
      if Row = 1 then begin
        Dec (TopLine);
        if TopLine < 1 then TopLine := 1;
        RedrawScreen;
      end;
    END;  {of procedure CursorUpOneLine}

  PROCEDURE CursorDownOneLine;
    BEGIN
      if ExitKey = DownArrow then
        if CurrentLine >= theTextBuffer^.TotalLines + 1 then
          Exit;

      Inc (CurrentLine);
      Inc (Row);

      if Row > EditWindowHeight then begin
        Inc (TopLine);
        Row := EditWindowHeight;
        RedrawScreen;
      end;

      IF (ExitKey = Enter) or (ExitKey = RightArrow) THEN
        Cursor := 1;

    END;  {of procedure CursorDownOneline}

  procedure SplitLine;
    var
      CurrentLineStr,
      RightPart : string;
      Count : byte;
    begin
      CurrentLineStr := theTextBuffer^.StringFromArray (CurrentLine);
      Count := Length (CurrentLineStr) - Cursor + 1;
      RightPart := RightStr (CurrentLineStr, Count);
      Delete (CurrentLineStr, Cursor, Count);
      theTextBuffer^.StringToArray (CurrentLineStr, CurrentLine);
      theTextBuffer^.InsertLine (RightPart, CurrentLine + 1);
    end;

  procedure DoEnter;
    begin
      if InsertFlag then
        SplitLine;
      CursorDownOneLine;
      if InsertFlag then
        RedrawScreen;
    end;

  procedure DoBackSpace;
    var
      TempStr : string;
      OK : boolean;
    begin
      if CurrentLine = 1 then begin
        Cursor := Col;
        Exit;
      end;
      if CurrentLine > 1 then begin
        TempStr := theTextBuffer^.StringFromArray (CurrentLine - 1);
        TempStr := Copy (TempStr, 1, Length (TempStr) - 1);
        OK := theTextBuffer^.StringToArray (TempStr, CurrentLine - 1);
        CursorUpOneLine;
        if Cursor < 1 then
          Cursor := EditWindowWidth;
      end;
    end;

  function ReformText (StartLine : integer) : integer;
    var
      Index : integer;
      CurrentStr,
      NextStr : string;
      SpaceAvailable,
      LengthOfFirstWord : byte;
      OK,
      CurrentLineDone,
      Done : boolean;

    { Returns the length of the first word of NextStr }
    function GetLengthOfFirstWord : byte;
      var
        Position : byte;
      begin
        if Length (NextStr) = 0 then begin
          GetLengthOfFirstWord := 0;
          Exit;
        end;
        Position := 1;
        while (NextStr[Position] <> Space) and (Position <= Length (NextStr)) do
          Inc (Position);
        if Position < Length (NextStr) then
          Dec (Position);
        GetLengthOfFirstWord := Position;
      end;

    { Returns the space available in CurrentStr }
    function GetSpaceAvailable : byte;
      var
        SpaceAvailable : byte;
      begin
        SpaceAvailable := EditWindowWidth - Length (CurrentStr) - 1;
        if SpaceAvailable < 0 then
          SpaceAvailable := 0;
        GetSpaceAvailable := SpaceAvailable;
      end;

    { Moves first word of NextStr to last position of CurrentStr }
    procedure MoveWordUp;
      var
        FirstWord : string;
      begin
        if Length (NextStr) = 0 then begin
          CurrentLineDone := true;
          Exit;
        end;

        LengthOfFirstWord := GetLengthOfFirstWord;
        FirstWord := Copy (NextStr, 1, LengthOfFirstWord);

        if (Length (CurrentStr) + LengthOfFirstWord + 1) > EditWindowWidth
        then begin
          CurrentLineDone := true;
          Exit;
        end;

        CurrentStr := CurrentStr + ' ' + FirstWord;

        Delete (NextStr, 1, LengthOfFirstWord);
        while NextStr[1] = Space do
          Delete (NextStr, 1, 1);
      end;

    { Fill out the current line with as many words as fit in EditWindowWidth }
    procedure FillCurrentLine;
      begin
        CurrentLineDone := false;
        while not CurrentLineDone do begin
          if Length (NextStr) = 0 then begin
            theTextBuffer^.DeleteLineFromArray (Index + 1);
            if theTextBuffer^.TextArray^[Index + 1] <> nil then
              NextStr := theTextBuffer^.StringFromArray (Index + 1)
            else
              CurrentLineDone := true;
            if (NextStr = '') or (NextStr[1] = ' ') then begin
              CurrentLineDone := true;
              Done := true;
            end;
          end;
          if not CurrentLineDone then
            MoveWordUp;
        end;
        OK := theTextBuffer^.StringToArray (CurrentStr, Index);
        if Length (NextStr) > 0 then
          OK := theTextBuffer^.StringToArray (NextStr, Index + 1);
      end;

  { Main of ReformText }
  begin
    Index := StartLine;
    Done := false;
    repeat
      CurrentStr := theTextBuffer^.StringFromArray (Index);
      (*
      if theTextBuffer^.TextArray^[Index + 1] <> nil then
        NextStr := theTextBuffer^.StringFromArray (Index + 1)
      else
        Done := true;
      *)
      if Index = theTextBuffer^.TotalLines then
        Done := true
      else
        NextStr := theTextBuffer^.StringFromArray (Index + 1);

      if (NextStr = '') or (NextStr[1] = ' ') then
        Done := true;

      if not Done then
        FillCurrentLine;

      Inc (Index);
    until Done;
    ReformText := Index - StartLine;
    RedrawScreen;
  end;

  procedure GlobalReform;
    var
      Index : integer;
    begin
      Index := 1;
      while theTextBuffer^.TextArray^[Index] <> nil do
        Index := Index + ReformText (Index);
      RedrawScreen;
    end;

  function InputFileName : string;
    var
      FileName : string;
      Cursor : byte;
      ExitKey : char;
      InsertFlag : boolean;
      SaveRow,
      SaveCursor : byte;
    begin
      InsertFlag := False;
      SaveCursor := WhereX;
      SaveRow := WhereY;
      Cursor := 11;
      FileName := '';
      Window (LeftX + 1, TopY + 1, RightX - 1, BottomY);
      TextAttr := Status_Attr;
      GotoXY (1, EditWindowHeight + 1); ClrEOL;
      Write ('Filename: ');
      ExitKey := EditLn (FileName,
                         Status_Attr,
                         InsertFlag,
                         Cursor, 11, EditWindowHeight + 1,
                         EditWindowWidth - 11,
                         true,
                         DoNothing);
    if ExitKey = Enter then
      InputFileName := ToUpper (FileName)
    else
      InputFileName := '';
    Window (LeftX + 1, TopY + 1, RightX - 1, BottomY - 1);
    TextAttr := Text_Attr;
    GotoXY (SaveCursor, SaveRow);
    DrawBox (LeftX, TopY, RightX, BottomY, Edit_Attr);
    FastWrite (Header, TopY, Leftx + 2, Edit_Attr);
  end;

  procedure ChopLongLine (var Line : string; Index : integer);
    var
      LeftPart : string;
      Position : byte;
      OK : boolean;
    begin
      Position := EditWindowWidth;
      while (line[Position] <> Space) and (Position >= 0) do
        Dec (Position);
      if Position = 0 then
        Position := EditWindowWidth;
      LeftPart := Copy (line, 1, Position);
      LeftPart := Strip (LeftPart);
      OK := theTextBuffer^.StringToArray (LeftPart, Index);
      Delete (line, 1, Position);
      while line[1] = Space do
        Delete (line, 1, 1);
    end;

  procedure LoadFile;
    var
      Index : integer;
      F : text;
      line : string;
      OK : boolean;
      ErrorStr : string;

    begin

      Assign (F, Filename);
      {$I-} Reset (F); {$I+}
      OK := IOResult = 0;
      if not OK then begin
        ErrorStr := MakeString (EditWindowWidth, ' ');
        ErrorStr := Merge ('File not found - press a key',
                            ErrorStr, 1);
        FastWrite (ErrorStr, BottomY, LeftX + 1, Status_Attr);
        Pause;
        FName := '';
        Exit;
      end;

      { Clear out current text, reset variables }
      theTextBuffer^.ClearTextArray;
      CurrentLine := 1;
      TopLine := 1;
      Row := 1;
      Col := 1;
      Cursor := Col;

      Index := 0;
      while not EOF (F) do begin
        Inc (Index);
        ReadLn (F, line);
        {if Length (line) > EditWindowWidth then begin}
        while Length (line) > EditWindowWidth do begin
          ChopLongLine (Line, Index);
          Inc (Index);
        end;
        {end;}
        OK := theTextBuffer^.StringToArray (line, Index);
      end;
      Close (F);
      RedrawScreen;
    end;

  procedure NewFile;
    var
      SaveFileName : string;
    begin
      SaveFileName := FileName;
      { Get name of file to load, error message if not found }
      FileName := InputFileName;
      if FileName = '' then begin
        FileName := SaveFileName;
        Exit;
      end else
        LoadFile;
    end;

  procedure SaveFile;
    var
      F : text;
      line : string;
      OK : boolean;
      Index : integer;
    begin
      if FileName = '' then begin
        FileName := InputFileName;
        FName := FileName;
      end;
      Assign (F, FileName);
      {$I-} Rewrite (F); {$I-}
      OK := IOResult = 0;
      Index := 0;
      while Index <= theTextBuffer^.TotalLines do begin
        Inc (Index);
        if theTextBuffer^.TextArray^[Index] <> nil then
          WriteLn (F, theTextBuffer^.StringFromArray (Index));
      end;
      Close (F);
    end;

  function WrapWord (var Current, Next : string) : byte;
    var
      Position : byte;
      WordToWrap : string;
    begin
      WordToWrap := '';
      { Find the start of last word on the current line }
      Position := Length (Current);
      while Current[Position] <> ' ' do
        Dec (Position);
      WordToWrap := Copy (Current, Position + 1, 255);
      if (InsertFlag) and (Next[1] <> ' ') and (Cursor < Length (Current)) then
        WordToWrap := WordToWrap + ' ';
      Delete (Current, Position, 255);
      if not InsertFlag then
        Delete (Next, 1, Length (WordToWrap));
      Insert (WordToWrap, Next, 1);
      WrapWord := Length (WordToWrap);
    end;

  procedure WrapText;
    var
      Index : integer;
      Current,
      Next : string;
      OK,
      Done : boolean;
      WrapLength,
      FirstWrapLength,
      DummyLength,
      Position,
      LineLength,
      Difference : byte;
      Iterations : integer;

    begin
      Index := CurrentLine;
      Done := false;
      Iterations := 0;
      LineLength := Length (theTextBuffer^.StringFromArray (CurrentLine));

      repeat
        Current := theTextBuffer^.StringFromArray (Index);
        (*
        if Index < theTextBuffer^.TotalLines then begin
          Next := theTextBuffer^.StringFromArray (Index + 1);
          if (Next = '') then begin
            OK := theTextBuffer^.InsertLine ('', Index + 1);
            Done := true;
          end
        end else
          Next := '';
        *)

        if theTextBuffer^.TextArray^[Index + 1] = nil then
          OK := theTextBuffer^.InsertLine ('', Index + 1);
        Next := theTextBuffer^.StringFromArray (Index + 1);

        WrapLength := WrapWord (Current, Next);


        if Iterations = 0 then
          FirstWrapLength := WrapLength;
        (*
        while Length (Current) > EditWindowWidth do
          DummyLength := WrapWord (Current, Next);
        *)

        { Save the lines as wrapped }
        OK := theTextBuffer^.StringToArray (Current, Index);
        OK := theTextBuffer^.StringToArray (Next, Index + 1);

        if not InsertFlag then
          Done := true;
        if Length (Next) <= EditWindowWidth then
          Done := true;

        { Insert mode }
        if InsertFlag then begin
          Inc (Index);
          Inc (Iterations);
        end;
    until Done;

    { Update screen }
    (*
    if not InsertFlag then begin
      GotoXY (Col, Row); ClrEOL;
      Write (Current);
      OK := theTextBuffer^.StringToArray (Next, Index + 1);
      GotoXY (Col, Row + 1); ClrEOL;
      Write (Next);
    end else
    *)
    RedrawScreen;

    { Position the cursor }
    if InsertFlag then begin
      { Cursor is past end of line }
      if Cursor > LineLength then begin
        CursorDownOneLine;
        Cursor := FirstWrapLength + 1;
      end;

      { Cursor is in the word that will be wrapped, i.e.
        pushing text right  }
      Difference := LineLength  - Cursor;
      if Difference < FirstWrapLength then begin
        CursorDownOneLine;
        Cursor := FirstWrapLength - Difference - 1;
      end;
    end;

    if not InsertFlag then begin
      Cursor := WrapLength + 1;
      CursorDownOneLine;
    end;
  end;


  {====================== START OF PROCESS =========================}
  begin
    if not WindowOpen then begin
      WriteLn ('Can''t Process in an EditWindow until you OpenWindow!!');
      Halt;
    end;
    StatusProc := UpdateStatus;
    UserQuits := false;
    FName := FileName;
    if FileName <> '' then
      LoadFile;
    StatusX := LeftX + 2;
    StatusY := BottomY;
    DrawBox (LeftX, TopY, RightX, BottomY, Edit_Attr);
    FastWrite (Header, TopY, Leftx + 2, Edit_Attr);
    SaveLine := '';
    Window (LeftX + 1, TopY + 1, RightX - 1, BottomY - 1);
    RedrawScreen;

    {==================== Main Loop =====================}
    repeat
      if EditAllowed then begin

        {Get current line from array}
        CurrentLineStr := theTextBuffer^.StringFromArray (CurrentLine);

        { Needed for the UpdateStatus procedure }
        Line := CurrentLine;

        { Call line editor to edit the string }
        ExitKey := EditLn (CurrentLineStr,
                           Edit_Attr,
                           InsertFlag,
                           Cursor,
                           Col, Row,
                           EditWindowWidth,
                           false,
                           StatusProc);

        if not theTextBuffer^.StringToArray (CurrentLineStr, CurrentLine) then
            begin end;

        GotoXY (1, Row); Write (CurrentLineStr);

        { Act on the key press that terminated editing current line }
        case ExitKey of
          #33..#127       : WrapText;
          RightArrow,
          DownArrow       : CursorDownOneLine;
          Enter           : DoEnter;
          LeftArrow       : begin
                              if CurrentLine > 1 then
                                Cursor := EditWindowWidth
                              else
                                Cursor := 1;
                              CursorUpOneLine;
                            end;
          UpArrow         : CursorUpOneLine;
          BackSpace       : DoBackSpace;
          AltR            : RedrawScreen;
          AltC            : begin
                              theTextBuffer^.ClearTextArray;
                              TopLine := 1;
                              CurrentLine := 1;
                              Row := 1;
                              Cursor := 1;
                              ClrScr;
                            end;
          PgDn            : ScrollScreenUp;
          PgUp            : ScrollScreenDown;
          ^Y              : DeleteLine;
          ^U              : UndeleteLine;
          AltB,
          AltJ            : ReformText (CurrentLine);
          AltG            : GlobalReform;
          CtlHome         : TopOfFile;
          F9              : NewFile;
          F10             : SaveFile;
        else
          UserQuits := true;
        end; {of case}
      end else begin
        RedrawScreen;
        Key := GetKey (DoNothing);
        case Key of
          Esc,
          Tab,
          AltX            : begin
                              UserQuits := true;
                              ExitKey := Key;
                            end;
          AltG            : GlobalReform;
          Home,
          CtlHome         : TopLine := 1;
          UpArrow         : if TopLine > 1 then
                              Dec (TopLine);
          DownArrow       : if TopLine < theTextBuffer^.TotalLines then
                              Inc (TopLine);
          PgUp            : begin
                              TopLine := TopLine - EditWindowHeight;
                              if TopLine < 1 then
                                TopLine := 1;
                            end;
          PgDn            : begin
                              TopLine := TopLine + EditWindowHeight;
                              if TopLine > theTextBuffer^.TotalLines then
                                TopLine := theTextbuffer^.TotalLines;
                            end;
          F9              : LoadFile;
        else
          UserQuits := true;
        end; { case }
      end;  { else }
    until UserQuits;
    DrawBox (LeftX, TopY, RightX, BottomY, Text_Attr);
  end;

  function TEditWindow.GetFileName : string;
    begin
      GetFileName := FileName;
    end;

  function TEditWindow.GetExitKey : char;
    begin
      GetExitKey := ExitKey;
    end;

  destructor TEditWindow.Done;
    begin
      Window (1, 1, 80, 25);
      TextAttr := SaveAttr;
      ClrScr;
    end;

begin
  FName := '';
  SaveAttr := TextAttr;
end.