Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/PASCAL.ZIP/EDIT.PAS

Pascal/Delphi Source File | 1980-01-01 | 43.2 KB | 1,576 lines

PROGRAM EDIT ;
  {$V-}

  CONST
    Blank = ' ' ;                           {A blank character}
    NullString = '' ;                       {A null string}
    MaxLines = 1000 ;                       {Maximum # of lines}
    EndOfLine = 79 ;                        {Maximum length of line}
    BottomOfScreen = 25 ;                   {Depth of window}
    BeginningOfLine = 1 ;                   {Left side of window}
    TopOfScreen = 1 ;                       {Top of window}
    Up = 1 ;                                {Cursor directions}
    Down = 2 ;
    Left = 3 ;
    Right = 4 ;
    ReadIt = TRUE ;                         {Control OpenFile}
    WriteIt = FALSE ;                       {Control OpenFile}
    BigCursor = 1 ;                         {Large editing cursor}
    SmallCursor = 2 ;                       {Normal cursor}
    RealBigCursor = 3 ;                     {Very large cursor}
    NoCursor = 4 ;                          {Cursor off}

  TYPE
    Lines = STRING[80] ;
    NotPtr = ^NotRec ;
    NotRec = RECORD
               Line : Lines ;
               InBlock : BOOLEAN ;
               Next : NotPtr ;
               Prev : NotPtr ;
             END ;
    TotFileName = STRING[14] ;

  VAR
    NotFile : TotFileName ;
    IntNotFile : TEXT ;
    Colr,NoMoreRoom,BlockBeginMarked,BlockEndMarked,Top : BOOLEAN ;
    NotCt : Byte ;
    BeginPtr,EndPtr,CurrLinePtr,NotTopPtr,NotBotPtr,ScrTopPtr : NotPtr ;
    I,J : Byte ;
    Ch : CHAR ;
    KeyChr,MKeystroke : CHAR ;
    MFKey : BOOLEAN ;
    X,Y,LinesThisPage,WordPtr,LineIdx : Byte ;
    Found,Ok,Funckey : BOOLEAN ;
    InChar : CHAR ;
    SearchString : Lines ;
    TempPtr : NotPtr ;

  PROCEDURE AddNode(Info:Lines) ;
    {Adds a node to the list following the line on which the cursor resides}

    VAR
      TempPtr : NotPtr ;

    BEGIN
      NEW(TempPtr) ;
      TempPtr^.Prev := NIL ;
      TempPtr^.Next := NIL ;
      TempPtr^.Line := Info ;
      TempPtr^.InBlock := FALSE ;
      NotCt := NotCt + 1 ;
      IF (NotCt = MaxLines) THEN
        NoMoreRoom := TRUE ;
      IF CurrLinePtr = NotBotPtr THEN
        BEGIN
          CurrLinePtr^.Next := TempPtr ;
          TempPtr^.Prev := CurrLinePtr ;
          NotBotPtr := TempPtr ;
        END
      ELSE
        BEGIN
          CurrLinePtr^.Next^.Prev := TempPtr ;
          TempPtr^.Prev := CurrLinePtr ;
          TempPtr^.Next := CurrLinePtr^.Next ;
          CurrLinePtr^.Next := TempPtr ;
        END ;
    END ;

  PROCEDURE BeepSound ;
    { Make a "beep" sound to alert the user of an invalid keystroke. }

    BEGIN
      Sound(660) ;
      Delay(100) ;
      Sound(880) ;
      Delay(50) ;
      NoSound ;
    END ;

  PROCEDURE ReadKeyStroke(VAR ch:CHAR ;
                          VAR FuncKey:BOOLEAN) ;
    { Reads keystroke from the keyboard without echoing it to the screen.     }
    { It distinguishes between "extended code" and "single code" key pressed. }

    BEGIN
      Funckey := FALSE ;
      READ(Kbd,ch) ;
      IF (ch = #27) AND KeyPressed THEN
        BEGIN
          READ(Kbd,ch) ;
          FuncKey := TRUE ;
        END ;
    END ;

  PROCEDURE SetSystemColors ;
    {Returns to system colors}

    BEGIN
      TextColor(15) ;
      TextBackGround(0) ;
    END ;

  PROCEDURE CursorSize(HowBig:Byte) ;
    { Depending on the in-parameter this procedure either turns off the cursor }
    { or turns it on and sets the cursor size to small/big or superbig resp.   }

    TYPE
      register = RECORD
                   CASE BOOLEAN OF
                     TRUE : (ax,bx,cx,dx,bp,si,di,ds,es,flags:INTEGER) ;
                     FALSE : (al,ah,bl,bh,cl,ch,dl,dh:Byte) ;
                 END ;

    VAR
      Regs : Register ;

    BEGIN
      WITH regs DO
        BEGIN
          CASE HowBig OF
            BigCursor : BEGIN
                          IF Colr THEN
                            cx := $0307
                          ELSE
                            cx := $080D
                        END ;
            SmallCursor : BEGIN
                            IF Colr THEN
                              cx := $0607
                            ELSE
                              cx := $0B0D
                          END ;
            RealBigCursor : BEGIN
                              IF Colr THEN
                                cx := $0007
                              ELSE
                                cx := $000D
                            END ;
            NoCursor : cx := $3200 ;
          END ;
          ah := $01 ;
          bx := $0 ;
          Intr($10,Regs) ;
        END ;
    END ;

  PROCEDURE DetermineDisplay ;
    { Set ScreenBase to $B000 or $B800, depending on which display is in use.}
    { Sets global variable COLR to true if color screen, false if monochrome }

    VAR
      t : Byte ;

    BEGIN
      t := (Mem[0000:$0410] AND $0030) ;
      IF (t = $0030) THEN
        colr := FALSE
      ELSE
        colr := TRUE ;
    END ;

  PROCEDURE Regress(VAR ThePtr:NotPtr) ;
    {Moves a pointer towards top of the list}

    BEGIN
      ThePtr := ThePtr^.Prev ;
    END ;

  PROCEDURE Advance(VAR ThePtr:NotPtr) ;
    {Moves a pointer towards bottom of the list}

    BEGIN
      ThePtr := ThePtr^.Next ;
    END ;

  PROCEDURE Inc(VAR TheValue:Byte) ;

    BEGIN
      TheValue := TheValue + 1 ;
    END ;

  PROCEDURE Dec(VAR TheValue:Byte) ;

    BEGIN
      TheValue := TheValue - 1 ;
    END ;

  PROCEDURE CheckPosition(VAR ScreenCol,ScreenRow:Byte) ;
    {This procedure gets and returns the screen position via}
    {the standard Turbo WhereX and WhereY}

    BEGIN
      ScreenCol := WhereX ;
      ScreenRow := WhereY ;
    END ;

  PROCEDURE RvsOn ;
    {Turns on reverse video}

    BEGIN
      IF Colr THEN
        BEGIN
          TextBackGround(14) ;
          TextColor(1) ;
        END
      ELSE
        BEGIN
          TextBackGround(7) ;
          TextColor(0) ;
        END
    END ;

  PROCEDURE RvsOff ;
    {Turns off reverse video}

    BEGIN
      TextBackGround(0) ;
      IF Colr THEN
        TextColor(14)
      ELSE
        TextColor(15)
    END ;

  FUNCTION LengthThisLine : Byte ;
    {Returns the length of the current line}

    BEGIN
      LengthThisLine := LENGTH(CurrLinePtr^.Line) ;
    END ;

  FUNCTION ThereIsASpace : BOOLEAN ;

    BEGIN
      ThereIsASpace := FALSE ;
      FOR i := 1 TO LengthThisLine DO
        IF CurrLinePtr^.Line[i] = #32 THEN
          ThereIsASpace := TRUE ;
    END ;

  FUNCTION SpacesOnly : BOOLEAN ;
    {Returns true if no characters other than space on line}

    BEGIN
      SpacesOnly := TRUE ;
      FOR i := 1 TO LengthThisLine DO
        IF CurrLinePtr^.Line[i] <> #32 THEN
          SpacesOnly := FALSE ;
    END ;

  FUNCTION BlockMarkedOK : BOOLEAN ;
    {Returns true if proper block of text marked}

    BEGIN
      IF BlockBeginMarked AND BlockEndMarked THEN
        BEGIN
          BlockMarkedOK := TRUE ;
          TempPtr := NotTopPtr ;
          WHILE TempPtr <> BeginPtr DO
            IF TempPtr = EndPtr THEN
              BEGIN
                BlockMarkedOK := FALSE ;
                exit ;
              END
            ELSE
              Advance(TempPtr) ;
        END
      ELSE
        BlockMarkedOK := FALSE ;
    END ;

  FUNCTION OkToMove : BOOLEAN ;
    {Returns true if its ok to move a block of text}

    BEGIN
      OkToMove := FALSE ;
      IF BlockMarkedOk THEN
        BEGIN
          OkToMove := TRUE ;
          TempPtr := BeginPtr ;
          WHILE TempPtr <> EndPtr DO
            BEGIN
              IF CurrLinePtr = TempPtr THEN
                BEGIN
                  OkToMove := FALSE ;
                  exit ;
                END ;
              Advance(TempPtr) ;
            END ;
          IF CurrLinePtr = EndPtr THEN
            OkToMove := FALSE ;
        END ;
    END ;

  PROCEDURE DrawScreen ;
    {This procedure draws the text to the screen when the entire}
    {screen needs to be refreshed.}

    BEGIN
      ClrScr ;
      TempPtr := ScrTopPtr ;
      LinesThisPage := 0 ;
      WHILE (LinesThisPage < BottomOfScreen) AND (TempPtr <> NIL) DO
        BEGIN
          Inc(LinesThisPage) ;
          GotoXY(BeginningOfLine,LinesThisPage) ;
          IF TempPtr^.InBlock THEN
            RvsOn ;
          WRITE(TempPtr^.Line) ;
          RvsOff ;
          Advance(TempPtr) ;
        END ;
    END ;

  PROCEDURE HelpScrn ;
    { Gets specified help-file from disk and displays on screen line by line }
    { from specified help-file. }

    VAR
      Hlpfile : TEXT ;
      hlpname : STRING [64] ;
      helpbuff : STRING [73] ;
      KeyStroke : CHAR ;
      Fkey : BOOLEAN ;
      HelpScript : STRING [15] ;

    BEGIN
      ClrScr ;
      Hlpname := 'NPD.hlp' ;
      GotoXY(27,24) ;
      WRITE(' Press ESC to exit Help. ') ;
      Window(4,3,77,24) ;
      GotoXY(1,1) ;
      i := POS(hlpname,#32) ;
      IF i <> 0 THEN
        hlpname[0] := CHR(i - 1) ;
      Assign(hlpfile,hlpname) ;
      {$I-}
      RESET(hlpfile) ;
      {$I+}
      GotoXY(1,1) ;
      WHILE NOT EOF(hlpfile) DO
        BEGIN
          READLN(hlpfile,helpbuff) ;
          WRITELN(helpbuff) ;
        END ;
      CLOSE(hlpfile) ;
    END ;

  PROCEDURE Disphelp ;
    { Puts up the general help-window on the screen and calls HelpScrn to }
    { write the specified help-information on the screen.                 }

    VAR
      Keystroke : CHAR ;
      FKey : BOOLEAN ;

    BEGIN
      Window(1,1,80,25) ;
      HelpScrn ;
      REPEAT
        BEGIN
          ReadKeyStroke(KeyStroke,Fkey) ;
          IF (FKey = TRUE) THEN             { "Extended Code" keys pressed }
            BeepSound
          ELSE IF (KeyStroke <> #27) THEN
            BeepSound ;
        END ;
      UNTIL (KeyStroke = #27) ;
      ClrScr ;
      DrawScreen ;
    END ;

  PROCEDURE SetBlock ;
    {Establishes a a marked block and readies it to move}

    BEGIN
      IF BeginPtr^.Prev = NIL THEN
        BEGIN
          NotTopPtr := EndPtr^.Next ;
          NotTopPtr^.Prev := NIL ;
          EndPtr^.Next := NIL ;
        END
      ELSE IF EndPtr^.Next = NIL THEN
        BEGIN
          NotBotPtr := BeginPtr^.Prev ;
          NotBotPtr^.Next := NIL ;
          BeginPtr^.Prev := NIL ;
        END
      ELSE
        BEGIN
          BeginPtr^.Prev^.Next := EndPtr^.Next ;
          EndPtr^.Next^.Prev := BeginPtr^.Prev ;
          BeginPtr^.Prev := NIL ;
          EndPtr^.Next := NIL ;
        END ;
    END ;
  {PROCEDURE SetBlock}

  PROCEDURE ShowBlock(Status:BOOLEAN) ;
    {Set block to be displayed in reverse video}

    BEGIN
      TempPtr := BeginPtr ;
      TempPtr^.InBlock := Status ;
      WHILE TempPtr <> EndPtr DO
        BEGIN
          Advance(TempPtr) ;
          TempPtr^.InBlock := Status ;
        END ;
    END ;
  {PROCEDURE ShowBlock}

  PROCEDURE MoveBlock ;
    {Moves a block of text}

    BEGIN
      SetBlock ;
      IF CurrLinePtr = NotTopPtr THEN       {move block to top of notepad}
        BEGIN
          CurrLinePtr^.Prev := EndPtr ;
          EndPtr^.Next := CurrLinePtr ;
          NotTopPtr := BeginPtr ;
        END
      ELSE
        BEGIN
          CurrLinePtr^.Prev^.Next := BeginPtr ;
          EndPtr^.Next := CurrLinePtr ;
          BeginPtr^.Prev := CurrLinePtr^.Prev ;
          CurrLinePtr^.Prev := EndPtr ;
        END ;
      CurrLinePtr := BeginPtr ;
      ScrTopPtr := CurrLinePtr ;
      LineIdx := 0 ;
      DrawScreen ;
      GotoXY(BeginningOfLine,TopOfScreen) ;
    END ;

  PROCEDURE DeleteBlock ;
    {Deletes a block of text}

    BEGIN
      SetBlock ;
      WHILE BeginPtr <> EndPtr DO
        BEGIN
          TempPtr := BeginPtr ;
          Advance(BeginPtr) ;
          BeginPtr^.Prev := NIL ;
          Dispose(TempPtr) ;
          Dec(NotCt) ;
        END ;
      Dispose(BeginPtr) ;
      Dec(NotCt) ;
      BlockBeginMarked := FALSE ;
      BlockEndMarked := FALSE ;
      ScrTopPtr := CurrLinePtr ;
      LineIdx := 0 ;
      DrawScreen ;
      GotoXY(BeginningOfLine,TopOfScreen) ;
      NoMoreRoom := FALSE ;
    END ;
  {PROCEDURE DeleteBlock}

  PROCEDURE SortBlock ;
    {Sorts a marked block of notepad text using ASCII string values}

    VAR
      LineHolder,TempLine1,TempLine2 : Lines ;
      Done : BOOLEAN ;
      TempPtr1,TempPtr2 : NotPtr ;

    FUNCTION AllCaps(TempLine:Lines) : Lines ;

      VAR
        TempCaps : Lines ;

      BEGIN
        TempCaps := NullString ;
        FOR I := 1 TO LENGTH(TempLine) DO
          IF TempLine[I] <> ' ' THEN
            TempCaps := TempCaps + (UpCase(TempLine[I])) ;
        AllCaps := TempCaps
      END ;
    {FUNCTION AllCaps}

  BEGIN
    IF BlockMarkedOk THEN
      BEGIN
        Done := FALSE ;
        TempPtr2 := EndPtr ;
        WHILE NOT Done DO
          BEGIN
            TempPtr1 := BeginPtr ;
            Done := TRUE ;
            WHILE TempPtr1 <> TempPtr2 DO
              BEGIN
                TempLine1 := AllCaps(TempPtr1^.Line) ;
                TempLine2 := AllCaps(TempPtr1^.Next^.Line) ;
                IF TempLine1 > TempLine2 THEN
                  BEGIN
                    LineHolder := TempPtr1^.Line ;
                    TempPtr1^.Line := TempPtr1^.Next^.Line ;
                    TempPtr1^.Next^.Line := LineHolder ;
                    Done := FALSE ;
                  END ;
                Advance(TempPtr1) ;
              END ;
            Regress(TempPtr2) ;
          END ;
        CheckPosition(X,Y) ;
        DrawScreen ;
        GotoXY(X,Y) ;
      END
    ELSE
      BeepSound ;
  END ;
  {PROCEDURE SortBlock}

  PROCEDURE SetNoteColors ;
    {Sets colors for color or mono screen}

    BEGIN
      IF Colr THEN
        BEGIN
          TextColor(1) ;
          TextBackGround(0) ;
        END
      ELSE
        BEGIN
          TextColor(15) ;
          TextBackGround(0) ;
        END ;
    END ;

  PROCEDURE MarkBegin ;
    {Set mark begin pointer}

    BEGIN
      IF NOT BlockMarkedOK THEN
        BEGIN
          BeginPtr := CurrLinePtr ;
          BlockBeginMarked := TRUE ;
          IF BlockEndMarked THEN
            IF BlockMarkedOk THEN
              BEGIN
                ShowBlock(TRUE) ;
                CheckPosition(X,Y) ;
                DrawScreen ;
                GotoXY(X,Y) ;
              END
            ELSE
              BEGIN
                BlockBeginMarked := FALSE ;
                BeepSound ;
              END ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE MarkEnd ;
    {Set mark end pointer}

    BEGIN
      IF NOT BlockMarkedOK THEN
        BEGIN
          EndPtr := CurrLinePtr ;
          BlockEndMarked := TRUE ;
          IF BlockBeginMarked THEN
            IF BlockMarkedOK THEN
              BEGIN
                ShowBlock(TRUE) ;
                CheckPosition(X,Y) ;
                DrawScreen ;
                GotoXY(X,Y) ;
              END
            ELSE
              BEGIN
                BlockBeginMarked := FALSE ;
                BeepSound ;
              END ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE UnMarkBlock ;

    BEGIN
      IF BlockMarkedOK THEN
        BEGIN
          ShowBlock(FALSE) ;
          CheckPosition(X,Y) ;
          DrawScreen ;
          GotoXY(X,Y) ;
          BlockBeginMarked := FALSE ;
          BlockEndMarked := FALSE ;
          BeginPtr := NIL ;
          EndPtr := NIL ;
        END
      ELSE
        BeepSound ;
    END ;
  {PROCEDURE UnMarkBlock}

  PROCEDURE InitializePad ;

    BEGIN
      OK := FALSE ;
      WordPtr := BeginningOfLine ;
      LineIdx := 0 ;
      CursorSize(BigCursor) ;
      SetNoteColors ;
    END ;

  PROCEDURE AddChar ;
    {Inserts a character into current line then adjusts its length}

    BEGIN
      RvsOn ;
      IF LineIdx = LengthThisLine THEN
        BEGIN
          Inc(LineIdx) ;
          CurrLinePtr^.Line[0] := CHR(LineIdx) ;
        END
      ELSE
        Inc(LineIdx) ;
      CurrLinePtr^.Line[LineIdx] := InChar ;
      WRITE(InChar) ;
      RvsOff ;
    END ;

  PROCEDURE Home ;
    {Moves cursor to beginning of current line and sets line index}

    BEGIN
      IF LineIdx > 0 THEN
        BEGIN
          CheckPosition(X,Y) ;
          LineIdx := 0 ;
          GotoXY(BeginningOfLine,Y) ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE GoToEnd ;
    {Moves Cursor to end of current line and sets line index}

    BEGIN
      CheckPosition(X,Y) ;
      IF X <= LengthThisLine THEN
        BEGIN
          LineIdx := LengthThisLine ;
          GotoXY(LineIdx + 1,Y) ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE Tab ;
    {Moves five spaces to right inserting blanks till end of line}
    {if no characters on line yet.  Otherwise just moves five spaces}
    {without inserting blanks}

    BEGIN
      CheckPosition(X,Y) ;
      IF (X < LengthThisLine) THEN
        BEGIN
          IF ((X + 5) < LengthThisLine) THEN
            BEGIN
              LineIdx := LineIdx + 5 ;
              GotoXY(X + 5,Y) ;
            END
          ELSE
            BEGIN
              LineIdx := LengthThisLine ;
              GotoXY(LengthThisLine + 1,Y) ;
            END ;
        END
      ELSE IF (LineIdx = 0) OR SpacesOnly THEN
        BEGIN
          InChar := Blank ;
          IF (LineIdx + 5) < EndOfLine THEN
            FOR i := 1 TO 5 DO
              AddChar
          ELSE
            FOR i := LineIdx + 1 TO EndOfLine - 1 DO
              AddChar ;
        END ;
    END ;

  PROCEDURE FindWordPtr ;
    {Finds first non-space character after a space on the current line}

    BEGIN
      FOR i := BeginningOfLine TO EndOfLine DO
        IF (CurrLinePtr^.Line[i] = #32) THEN
          WordPtr := i + 1 ;
    END ;

  PROCEDURE DeleteCharLeft ;
    {Backspace deletion of character to left of cursor}

    BEGIN
      CheckPosition(X,Y) ;
      IF X > BeginningOfLine THEN
        BEGIN
          Dec(LineIdx) ;                    {Decrement line index}
          CurrLinePtr^.Line[X - 1] := Blank ;  {Insert a blank}
          GotoXY(X - 1,Y) ;
          WRITE(Blank) ;
          GotoXY(X - 1,Y) ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE DeleteCharRight ;
    {Del key deletion of character to right of cursor}

    BEGIN
      CheckPosition(X,Y) ;
      IF (LengthThisLine > 0) AND (X <= LengthThisLine) THEN
        BEGIN
          GotoXY(LengthThisLine,Y) ;
          WRITE(Blank) ;
          FOR i := X TO LengthThisLine - 1 DO
            CurrLinePtr^.Line[i] := CurrLinePtr^.Line[i + 1] ;
          IF LengthThisLine > 0 THEN
            CurrLinePtr^.Line[0] := CHR(LengthThisLine - 1)
          ELSE
            CurrLinePtr^.Line[0] := CHR(0) ;
          GotoXY(X,Y) ;
          FOR i := X TO LengthThisLine DO
            WRITE(CurrLinePtr^.Line[i]) ;
          GotoXY(X,Y) ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE SetCursor(LengthLastLine,LinesLastPage:Byte) ;
    {Adjusts cursor so it rests at the end of line on page}
    {if page is shorter or end of line if line is shorter}
    {If neither of these is true it goes to same line at same position}

    BEGIN
      IF LinesThisPage >= LinesLastPage THEN
        BEGIN
          IF (LengthThisLine <= LengthLastLine) AND (LengthThisLine <> 0) THEN
            BEGIN
              GotoXY(LengthThisLine + 1,LinesLastPage) ;
              LineIdx := LengthThisLine ;
            END
          ELSE IF LengthThisLine = 0 THEN
            BEGIN
              GotoXY(BeginningOfLine,LinesLastPage) ;
              LineIdx := 0 ;
            END
          ELSE
            BEGIN
              GotoXY(LengthLastLine,LinesLastPage) ;
              LineIdx := LengthLastLine - 1 ;
            END
        END
      ELSE
        BEGIN
          IF (LengthThisLine <= LengthLastLine) AND (LengthThisLine <> 0) THEN
            BEGIN
              GotoXY(LengthThisLine + 1,LinesThisPage) ;
              LineIdx := LengthThisLine ;
            END
          ELSE IF LengthThisLine = 0 THEN
            BEGIN
              GotoXY(BeginningOfLine,LinesThisPage) ;
              LineIdx := 0 ;
            END
          ELSE
            BEGIN
              GotoXY(LengthLastLine,LinesThisPage) ;
              LineIdx := LengthLastLine - 1 ;
            END ;
        END ;
    END ;

  PROCEDURE DeleteNode ;
    {Deletes the line upon which the cursor resides and moves all lines up}

    BEGIN
      Dec(NotCt) ;
      IF NotCt < MaxLines THEN
        NoMoreRoom := FALSE ;
      IF CurrLinePtr = NotTopPtr THEN
        BEGIN
          TempPtr := CurrLinePtr ;
          NotTopPtr := CurrLinePtr^.Next ;
          NotTopPtr^.Prev := NIL ;
          CurrLinePtr := NotTopPtr ;
          ScrTopPtr := NotTopPtr ;
          Dispose(TempPtr) ;
        END
      ELSE IF CurrLinePtr = NotBotPtr THEN
        BEGIN
          TempPtr := CurrLinePtr ;
          NotBotPtr := CurrLinePtr^.Prev ;
          NotBotPtr^.Next := NIL ;
          CurrLinePtr := NotBotPtr ;
          ScrTopPtr := NotBotPtr ;
          Dispose(TempPtr) ;
        END
      ELSE
        BEGIN
          IF CurrLinePtr = ScrTopPtr THEN
            Advance(ScrTopPtr)
          ELSE IF ScrTopPtr = NotBotPtr THEN
            Regress(ScrTopPtr) ;
          TempPtr := CurrLinePtr ;
          TempPtr^.Next^.Prev := TempPtr^.Prev ;
          TempPtr^.Prev^.Next := TempPtr^.Next ;
          CurrLinePtr := TempPtr^.Next ;
          Dispose(TempPtr) ;
        END ;
    END ;

  PROCEDURE LineInBlock(ThisLinePtr:NotPtr) ;

    BEGIN
      IF (BlockMarkedOk) AND ( NOT OkToMove) THEN
        ThisLinePtr^.InBlock := TRUE ;
    END ;
  {PROCEDURE LineInBlock}

  PROCEDURE InsertLine ;
    {Inserts a line above the current line and moves all lines down}

    BEGIN
      CheckPosition(X,Y) ;
      AddNode(CurrLinePtr^.Line) ;
      LineInBlock(CurrLinePtr^.Next) ;
      CurrLinePtr^.Line := NullString ;
      LineIdx := 0 ;
      DrawScreen ;
      GotoXY(BeginningOfLine,Y) ;
    END ;

  PROCEDURE DeleteLine ;
    {Deletes the line on which the cursor resides}

    BEGIN
      IF (BlockMarkedOk) AND ( NOT OkToMove) THEN
        IF BeginPtr <> EndPtr THEN
          IF CurrLinePtr = BeginPtr THEN
            BeginPtr := BeginPtr^.Next
          ELSE IF CurrLinePtr = EndPtr THEN
            EndPtr := EndPtr^.Prev ;
      CheckPosition(X,Y) ;
      DeleteNode ;
      DrawScreen ;
      SetCursor(x,y) ;
    END ;

  PROCEDURE StartFresh ;
    {Creates a new note list}

    BEGIN
      NEW(NotTopPtr) ;
      NotTopPtr^.Next := NIL ;
      NotTopPtr^.Prev := NIL ;
      NotTopPtr^.Line := NullString ;
      NotTopPtr^.InBlock := FALSE ;
      ScrTopPtr := NotTopPtr ;
      NotBotPtr := NotTopPtr ;
      CurrLinePtr := NotTopPtr ;
      NotCt := 1 ;
      OK := TRUE ;
      DrawScreen ;
      GotoXY(BeginningOfLine,TopOfScreen) ;
    END ;

  PROCEDURE MoveCursor(ArrowKey:Byte) ;
    {Moves cursor appropriately when arrow keys are pressed}

    BEGIN
      CheckPosition(X,Y) ;
      IF NOT ((X = BeginningOfLine) AND (ArrowKey = Left)) THEN
        IF NOT ((X > LengthThisLine) AND (ArrowKey = Right)) THEN
          CASE ArrowKey OF
            Up : IF (CurrLinePtr = ScrTopPtr) AND (CurrLinePtr <> NotTopPtr)
                        THEN
                   BEGIN
                     Regress(CurrLinePtr) ;
                     Regress(ScrTopPtr) ;
                     DrawScreen ;
                     SetCursor(X,Y) ;
                   END
                 ELSE IF (CurrLinePtr <> ScrTopPtr) AND (CurrLinePtr <>
                        NotTopPtr) THEN
                   BEGIN
                     Regress(CurrLinePtr) ;
                     SetCursor(X,Y - 1) ;
                   END
                 ELSE
                   BeepSound ;
            Down : IF (Y = BottomOfScreen) AND (CurrLinePtr <> NotBotPtr) THEN
                     BEGIN
                       Advance(CurrLinePtr) ;
                       Advance(ScrTopPtr) ;
                       DrawScreen ;
                       SetCursor(X,Y) ;
                     END
                   ELSE IF (Y <> BottomOfScreen) AND (CurrLinePtr <> NotBotPtr)
                          THEN
                     BEGIN
                       Advance(CurrLinePtr) ;
                       SetCursor(X,Y + 1) ;
                     END
                   ELSE
                     BeepSound ;
            Left : BEGIN
                     GotoXY(X - 1,Y) ;
                     Dec(LineIdx) ;
                   END ;
            Right : BEGIN
                      GotoXY(X + 1,Y) ;
                      Inc(LineIdx) ;
                    END ;
          END                               {CASE}
        ELSE
          BeepSound
      ELSE
        BeepSound ;
    END ;

  PROCEDURE PageUp ;
    {Moves up one page or as far as possible if less than one page left}

    BEGIN
      IF ScrTopPtr <> NotTopPtr THEN
        BEGIN
          i := 0 ;
          WHILE (i < BottomOfScreen) AND (ScrTopPtr^.Prev <> NIL) DO
            BEGIN
              Inc(i) ;
              Regress(ScrTopPtr) ;
              Regress(CurrLinePtr) ;
            END ;
          DrawScreen ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE PageDown ;
    {Moves down one page or as far as possible if less than one page left}

    BEGIN
      IF LinesThisPage > 1 THEN
        BEGIN
          i := 0 ;
          j := 0 ;
          WHILE (i < BottomOfScreen) AND (ScrTopPtr^.Next <> NIL) DO
            BEGIN
              Inc(i) ;
              Advance(ScrTopPtr) ;
            END ;
          WHILE (j < i) AND (CurrLinePtr^.Next <> NIL) DO
            BEGIN
              Inc(j) ;
              Advance(CurrLinePtr) ;
            END ;
          DrawScreen ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE WordWrap ;
    {The following procedure is called from the main driver when}
    {an entire word must be moved to the Next line.  It causes all }
    {characters written to the screen since the last space to be}
    {moved to the Next line and the preceeding line to be shortened by}
    {the length of the word which was wrapped!.}

    VAR
      TempString : Lines ;

    BEGIN
      FindWordPtr ;
      CheckPosition(X,Y) ;
      TempString := NullString ;
      i := WordPtr ;
      WHILE i <= EndOfLine DO
        BEGIN
          TempString := TempString + CurrLinePtr^.Line[i] ;
          Inc(i) ;
        END ;
      TempString := TempString + InChar ;
      CurrLinePtr^.Line[0] := CHR(LengthThisLine - LENGTH(TempString) + 1) ;
      LineIdx := LENGTH(TempString) ;
      AddNode(TempString) ;
      Advance(CurrLinePtr) ;
      LineInBlock(CurrLinePtr) ;
      IF Y = BottomOfScreen THEN
        BEGIN
          Advance(ScrTopPtr) ;
          Dec(Y) ;
        END ;
      DrawScreen ;
      GotoXY(LineIdx + 1,Y + 1) ;
    END ;

  PROCEDURE WrapAround ;
    {If no wordwrap required, this adds a new node and continues writing}
    {characters at the beginning of the Next line}

    BEGIN
      CheckPosition(X,Y) ;
      LineIdx := 0 ;
      AddNode(NullString) ;
      Advance(CurrLinePtr) ;
      LineInBlock(CurrLinePtr) ;
      IF Y = BottomOfScreen THEN
        BEGIN
          Advance(ScrTopPtr) ;
          Dec(Y) ;
        END ;
      DrawScreen ;
      GotoXY(LineIdx + 1,Y + 1) ;
      AddChar ;
    END ;

  PROCEDURE EitherEndOfFile(WhichEnd:NotPtr) ;
    {Moves to very beginning or end of notes}

    BEGIN
      IF CurrLinePtr <> WhichEnd THEN
        BEGIN
          CurrLinePtr := WhichEnd ;
          ScrTopPtr := WhichEnd ;
          LineIdx := 0 ;
          DrawScreen ;
          GotoXY(BeginningOfLine,TopOfScreen) ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE EraseToEnd ;
    {Erases line from character at current cursor position to end of line}

    BEGIN
      IF ((LineIdx = 0) AND SpacesOnly) OR (LineIdx = LengthThisLine) THEN
        BeepSound
      ELSE
        BEGIN
          CheckPosition(X,Y) ;
          CurrLinePtr^.Line[0] := CHR(X - 1) ;
          DrawScreen ;
          GotoXY(X,Y) ;
        END ;
    END ;

  PROCEDURE Search(StringToFind:Lines) ;
    {This procedure finds a string in the notes if it exists}

    TYPE
      StringIndex = 1..EndOfLine ;
      StringLength = 0..EndOfLine ;

    VAR
      SubLength,FullLength,MatchCount,WindowPosition : StringLength ;
      SubIndex : StringIndex ;

    PROCEDURE FindString(StringToSearch:Lines) ;
      {This is the actual search routine}

      BEGIN
        MatchCount := 0 ;
        WindowPosition := 0 ;
        SubIndex := 1 ;
        FullLength := LENGTH(StringToSearch) ;
        WHILE (MatchCount < SubLength) AND ((WindowPosition + Sublength) <=
                                            FullLength) DO
          IF TempPtr^.Line[WindowPosition + SubIndex] = StringToFind[SubIndex]
                 THEN
            BEGIN
              MatchCount := MatchCount + 1 ;
              SubIndex := SubIndex MOD SubLength + 1 ;
            END
          ELSE
            BEGIN
              MatchCount := 0 ;
              WindowPosition := WindowPosition + 1 ;
            END ;
        IF MatchCount = SubLength THEN
          Found := TRUE
        ELSE
          Found := FALSE ;
      END ;
    BEGIN
      SubLength := LENGTH(StringToFind) ;
      Found := FALSE ;
      TempPtr := CurrLinePtr ;
      WHILE (TempPtr <> NIL) AND NOT Found DO
        BEGIN
          FindString(TempPtr^.Line) ;
          IF NOT Found THEN
            Advance(TempPtr) ;
        END ;
      IF Found THEN
        BEGIN
          CurrLinePtr := TempPtr ;
          ScrTopPtr := TempPtr ;
          IF WindowPosition = 0 THEN
            WindowPosition := 1 ;
          LineIdx := WindowPosition - 1 ;
          DrawScreen ;
          GotoXY(WindowPosition,TopOfScreen) ;
        END
      ELSE
        BEGIN
          ClrScr ;
          GotoXY(5,4) ;
          RvsOn ;
          WRITE('Search String Not Found - Press Enter To Continue') ;
          READ ;
          RvsOff ;
          DrawScreen ;
          GotoXY(X,Y) ;
        END ;
    END ;

  PROCEDURE InsertChar ;
    {Inserts a character to the right of the cursor and pushes all other}
    {characters to the right}

    BEGIN
      CheckPosition(X,Y) ;
      IF (LengthThisLine < EndOfLine) AND (LineIdx >= 0) THEN
        BEGIN
          CurrLinePtr^.Line[0] := CHR(LengthThisLine + 1) ;
          FOR i := LengthThisLine DOWNTO LineIdx + 1 DO
            BEGIN
              CurrLinePtr^.Line[i] := CurrLinePtr^.Line[i - 1] ;
              GotoXY(i,Y) ;
              WRITE(CurrLinePtr^.Line[i]) ;
            END ;
          GotoXY(X,Y) ;
          AddChar ;
        END
      ELSE
        BeepSound ;
    END ;

  PROCEDURE WriteFile ;
    {This procedure writes the list of note line records to disk as a record}
    {the file must already have been opened with OpedFile}

    BEGIN
      TempPtr := NotTopPtr ;
      WHILE TempPtr <> NIL DO
        BEGIN
          WRITELN(IntNotFile,TempPtr^.Line) ;
          Advance(TempPtr) ;
        END ;
      CLOSE(IntNotFile) ;
    END ;

  PROCEDURE ReadFile ;
    {This procedure reads a file of records and builds the internal}
    {line list while adjusting the screen top pointer, the note bottom}
    {pointer and the current line ptr. It also counts the records into}
    {the module golbal variable NotCt.  The file must have been previously}
    {opened by OpenFile}

    VAR
      ALine : Lines ;

    BEGIN
      NEW(NotTopPtr) ;
      NotTopPtr^.Prev := NIL ;
      NotTopPtr^.Next := NIL ;
      NotTopPtr^.Line := NullString ;
      NotTopPtr^.InBlock := FALSE ;
      READLN(IntNotFile,NotTopPtr^.Line) ;
      CurrLinePtr := NotTopPtr ;
      ScrTopPtr := NotTopPtr ;
      NotBotPtr := NotTopPtr ;
      NotCt := 1 ;
      WHILE NOT EOF(IntNotFile) DO
        BEGIN
          READLN(IntNotFile,ALine) ;
          AddNode(ALine) ;
          LineInBlock(CurrLinePtr) ;
          CurrLinePtr := NotBotPtr ;
        END ;
      CurrLinePtr := NotTopPtr ;
      CLOSE(IntNotFile) ;
    END ;

  PROCEDURE OpenFile(Resett:BOOLEAN) ;
    {This procedure opens the file with the specified name in the variable}
    {notfile for either reading or writing depending upon the value of the}
    {the boolean resett.  If true the file is opened for reading, otherwise}
    {it is opened for writing}

    BEGIN
      Assign(IntNotFile,NotFile) ;
      {$I-}
      IF Resett THEN
        RESET(IntNotFile)
      ELSE
        REWRITE(IntNotFile) ;
      {$I+}
      Ok := (IOResult = 0) ;
      i := 0 ;
      WHILE ( NOT Ok) AND (i < 2) DO
        BEGIN
          ClrScr ;
          Inc(i) ;
          GotoXY(11,2) ;
          TextColor(15) ;
          RvsOn ;
          WRITE('Error With Disk Or Incorrect File Name !') ;
          RvsOff ;
          GotoXY(7,4) ;
          TextColor(7) ;
          WRITE('Please Check ') ;
          WRITE(' Drive and Press Enter When Ready') ;
          READ ;
          ClrScr ;
          {$I-}
          IF Resett THEN
            RESET(IntNotFile)
          ELSE
            REWRITE(IntNotFile) ;
          {$I+}
          Ok := (IOResult = 0) ;
        END ;
      SetNoteColors ;
    END ;

  PROCEDURE SaveFile ;

    BEGIN
      ClrScr ;
      GotoXY(12,7) ;
      WRITE('Do You Want To Save Notes (Y/N) ?') ;
      REPEAT
        ReadKeyStroke(InChar,FuncKey) ;
        InChar := UpCase(InChar) ;
        IF InChar = 'Y' THEN
          BEGIN
            REPEAT
              OpenFile(WriteIt) ;
            UNTIL Ok ;
            WriteFile ;
          END
        ELSE IF InChar = 'N' THEN
          BEGIN
            GotoXY(20,8) ;
            WRITE('Are You Sure (Y/N) ?') ;
            ReadKeyStroke(InChar,FuncKey) ;
            InChar := UpCase(InChar) ;
          END
        ELSE
          BeepSound ;
      UNTIL InChar IN ['Y','N'] ;
      IF InChar = 'N' THEN
        BEGIN
          REPEAT
            OpenFile(WriteIt) ;
          UNTIL Ok ;
          WriteFile ;
        END ;
    END ;

  PROCEDURE GetFileName ;
    {Gets the file name}

    VAR
      FirstCharNum : BOOLEAN ;

    BEGIN
      NotFile := NullString ;
      GotoXY(29,6) ;
      ClrEol ;
      GotoXY(29,6) ;
      RvsOn ;
      WRITE('            ') ;
      RvsOff ;
      GotoXY(29,6) ;
      REPEAT
        IF (NotFile = NullString) AND (InChar IN [#48..#57]) THEN
          FirstCharNum := TRUE
        ELSE
          FirstCharNum := FALSE ;
        WHILE FuncKey OR NOT (InChar IN [#8,#13,#46,#65..#90,#48..#57]) OR
               FirstCharNum DO
          BEGIN
            BeepSound ;
            ReadKeyStroke(InChar,FuncKey) ;
            InChar := UpCase(InChar) ;
            IF (NotFile = NullString) AND (InChar IN [#48..#57]) THEN
              FirstCharNum := TRUE
            ELSE
              FirstCharNum := FALSE ;
          END ;
        IF (InChar = #8) AND NOT (NotFile = NullString) THEN
          BEGIN
            CheckPosition(X,Y) ;
            GotoXY(X - 1,Y) ;
            RvsOn ;
            WRITE(Blank) ;
            RvsOff ;
            GotoXY(X - 1,Y) ;
            NotFile[0] := CHR(LENGTH(NotFile) - 1) ;
          END
        ELSE IF (InChar = #8) AND (NotFile = NullString) THEN
          BeepSound ;
        IF InChar IN [#65..#90,#46,#48..#57] THEN
          BEGIN
            WRITE(InChar) ;
            NotFile := NotFile + InChar ;
          END ;
        ReadKeyStroke(InChar,FuncKey) ;
        InChar := UpCase(InChar) ;
      UNTIL (LENGTH(NotFile) = 12) OR (InChar = #13) ;
      IF NotFile = NullString THEN
        NotFile := 'DEFAULT.DOC' ;
      GotoXY(x -1,y);  {### This is a guess original (}
end;

procedure FileDriver ;
    {This procedure is called by notepad when initializing.  It prints the}
    {default file name and prompts for a new file name.  If enter is pressed,}
    {the default file is loaded otherwise the user is asked weather the file is}
    {a new file, if so no file is opened but the screen is drawn and the cursor}
    {is positioned at the first column, first row.  If it is an old file, the}
    {file is opened and read and the screen drawn}

    BEGIN
      REPEAT
        Ok := FALSE ;
        ClrScr ;
        GotoXY(19,3) ;
        WRITE('Please Enter a New FileName') ;
        GotoXY(30,4) ;
        WRITE('OR') ;
        GotoXY(19,5) ;
        WRITE('Press <ENTER> for Default File') ;
        GotoXY(19,6) ;
        WRITE('FileName: ') ;
        GotoXY(29,6) ;
        WRITE('DEFAULT.DOC') ;
        REPEAT
          ReadKeyStroke(InChar,FuncKey) ;
          InChar := UpCase(InChar) ;
          IF FuncKey THEN
            BeepSound ;
        UNTIL NOT FuncKey ;
        IF (InChar IN ['A'..'Z','a'..'z']) THEN
          BEGIN
            GetFileName ;
            GotoXY(19,8) ;
            WRITE('Is This a New File (Y/N) ? ') ;
            REPEAT
              ReadKeyStroke(InChar,FuncKey) ;
              InChar := UpCase(InChar) ;
              IF InChar = 'Y' THEN
                StartFresh
              ELSE IF InChar = 'N' THEN
                BEGIN
                  OpenFile(ReadIt) ;
                  IF OK THEN
                    BEGIN
                      ReadFile ;
                      CheckPosition(X,Y) ;
                      DrawScreen ;
                      GotoXY(BeginningOfLine,TopOfScreen) ;
                    END ;
                END
              ELSE
                BeepSound ;
            UNTIL InChar IN ['Y','N'] ;
          END
        ELSE IF InChar = #13 THEN
          BEGIN
            NotFile := 'Default.Doc' ;
            OpenFile(ReadIt) ;
            IF OK THEN
              BEGIN
                ReadFile ;
                CheckPosition(X,Y) ;
                DrawScreen ;
                GotoXY(BeginningOfLine,TopOfScreen) ;
              END ;
          END
        ELSE
          BeepSound ;
      UNTIL OK ;
    END ;

  PROCEDURE BigCase ;
    {Case to act on extended code keys}

    BEGIN
      CASE InChar OF
        #23 : IF NotCt < MaxLines THEN
                InsertLine
              ELSE
                BeepSound ;
        #32 : IF NotCt > 1 THEN
                DeleteLine
              ELSE
                BEGIN
                  BeepSound ;
                  StartFresh ;
                END ;
        #48 : MarkBegin ;
        #18 : MarkEnd ;
        #47 : IF OkToMove THEN
                MoveBlock
              ELSE
                BeepSound ;
        #22 : UnMarkBlock ;
        #72 : MoveCursor(Up) ;
        #80 : MoveCursor(Down) ;
        #75 : MoveCursor(Left) ;
        #77 : MoveCursor(Right) ;
        #82 : BEGIN
                CursorSize(RealBigCursor) ;
                ReadKeyStroke(InChar,FuncKey) ;
                WHILE NOT (FuncKey AND (InChar = #82)) DO
                  BEGIN
                    IF (InChar IN [#32..#125]) AND NOT (FuncKey) THEN
                      InsertChar
                    ELSE
                      BeepSound ;
                    ReadKeyStroke(InChar,FuncKey) ;
                  END ;
                CursorSize(BigCursor) ;
              END ;
        #73 : BEGIN
                CheckPosition(X,Y) ;
                PageUp ;
                SetCursor(X,Y) ;
              END ;
        #19 : IF OkToMove THEN
                DeleteBlock
              ELSE
                BeepSound ;
        #24 : SortBlock ;
        #33 : BEGIN
                CheckPosition(X,Y) ;
                ClrScr ;
                SearchString := NullString ;
                GotoXY(2,4) ;
                WRITE('ENTER SEARCH STRING: ') ;
                READLN(SearchString) ;
                Search(SearchString) ;
              END ;
        #71 : Home ;
        #79 : GoToEnd ;
        #34 : EitherEndOfFile(NotTopPtr) ;
        #49 : EitherEndOfFile(NotBotPtr) ;
        #46 : EraseToEnd ;
        #59 : DispHelp ;
        #81 : BEGIN
                CheckPosition(X,Y) ;
                PageDown ;
                SetCursor(X,Y) ;
              END ;
        #83 : DeleteCharRight ;
        ELSE
          BeepSound ;
      END ;
    END ;

  PROCEDURE LittleCase ;
    {Case to act on non-extended code keys}

    BEGIN
      CASE InChar OF
        #32..#125 : BEGIN
                      IF (LengthThisLine = EndOfLine) AND ThereIsASpace AND (
                             LineIdx = EndOfLine) THEN
                        WordWrap
                      ELSE IF (LengthThisLine = EndOfLine) AND (LineIdx =
                             EndOfLine) THEN
                        WrapAround
                      ELSE
                        AddChar ;
                    END ;
        #8 : DeleteCharLeft ;
        #9 : Tab ;
        #13 : IF NotCt < MaxLines THEN
                BEGIN
                  CheckPosition(X,Y) ;
                  LineIdx := 0 ;
                  WordPtr := BeginningOfLine ;
                  AddNode(NullString) ;
                  Advance(CurrLinePtr) ;
                  LineInBlock(CurrLinePtr) ;
                  IF Y = BottomOfScreen THEN
                    Advance(ScrTopPtr)
                  ELSE
                    Inc(Y) ;
                  DrawScreen ;
                  GotoXY(BeginningOfLine,Y) ;
                END
              ELSE
                BeepSound ;
        ELSE IF NOT (InChar = #27) THEN
          BeepSound ;
      END ;
    END ;

  PROCEDURE GetUserInput ;

    BEGIN
      REPEAT
        ReadKeyStroke(InChar,FuncKey) ;
        IF NotCt = MaxLines THEN
          IF (FuncKey AND (InChar = #23)) OR (InChar = #13) OR ( NOT FuncKey
                 AND (InChar IN [#32..#125]) AND (LengthThisLine = EndOfLine)
                 AND (LineIdx = EndOfLine)) OR ((InChar = #82) AND (
                                                LengthThisLine = EndOfLine))
                 THEN
            BEGIN
              ClrScr ;
              GotoXY(17,5) ;
              WRITE('         Edit Full - Leaving Edit') ;
              Delay(3000) ;
              Exit ;
            END ;
        IF FuncKey THEN
          BigCase
        ELSE
          LittleCase ;
      UNTIL (InChar = #27) ;
    END ;
  {=============================================================}
  {                MAIN NOTEPAD                                 }
  {=============================================================}

  BEGIN
    DetermineDisplay ;
    InitializePad ;
    NotFile := NullString ;
    NotCt := 0 ;
    BeginPtr := NIL ;
    EndPtr := NIL ;
    BlockBeginMarked := FALSE ;
    BlockEndMarked := FALSE ;
    FileDriver ;
    GetUserInput ;
     SaveFile ;
    CursorSize(NoCursor) ;
    SetSystemColors ;
    CursorSize(SmallCursor) ;
    ClrScr ;
  END.