[Back to TEXTEDIT SWAG index] [Back to Main SWAG index] [Original]

    {
     This is a very simple editor for ascii text files. It uses an array of
     pointers and dynamic memory allocation for every line, so that lines can
     easily be inserted or deleted without moving huge amounts of data.
     There is no saving available, but this should be easy to include.

     I recommend compiling this as a protected mode application (far more
     memory available), but you can also use it in real mode, if you want.
     You can edit texts of every size (no 64K limit), they just have to fit
     into your memory.

     This is Public Domain, feel free to use it for whatever you like, but at
     your own risk !

     Any questions, comments, etc. : heiner@rummelplatz.uni-mannheim.de
                                     Alexander Heiner
    }

    uses crt,dos;
    {$F+}

    type
        D_LStr = record
            StrLen: word;
            Str: array[0..16383] of byte;
        end;
        P_LStr = ^D_Lstr;

        D_TmpStr=array[0..16383] of char;

    var
        LStr: array[0..16000] of P_LStr;
        TmpStr: ^D_TmpStr;
        YscrlPos,XscrlPos:longint;
        CrX,CrY:word;
        MaxLines:longint;
        ch:char;
        FName:string;

    procedure OutString(x,y:word;s:string;tcol,bcol:byte);
    var p:pointer;
    begin
         p:=@s;
         asm
            push    ds
            mov     ax,SegB800
            lds     si,p
            mov     es,ax
            imul    di,y,160
            mov     ax,x
            shr     ax,1
            add     di,ax
            mov     ah,bcol
            shl     ah,4
            add     ah,tcol
            mov     cl,ds:[si]
            inc     si
    @l1:
            lodsb
            stosw
            dec     cl
            jnz     @l1

            pop     ds
         end;
    end;

    procedure LoadText(Fname:string);
    var f:text;a,b:word;s:string;gmem:longint;
    begin
         getmem(tmpStr,16384);
         assign(f,Fname);
         reset(f);
         a:=0;gmem:=0;
         while not eof(f) do begin
               readln(f,TmpStr^);
               b:=0;while TmpStr^[b]<>#0 do inc(b);

               if memavail>=2+b then begin
                  getmem(LStr[a],2+b);
                  move(TmpStr^,LStr[a]^.Str,b);
                  Lstr[a]^.StrLen:=b;
                  inc(gmem,b+2);
               end else begin outstring(0,3,'Not enough memory.',7,0);halt(1);end;

               inc(a);if a>16000 then begin
               outstring(0,3,'Line overflow (max.16000)',7,0);halt(1);end;

               str(a,s);outstring(0,0,'lines loaded: '+s,7,0);
               str(gmem,s);outstring(0,1,'memory allocated: '+s+ ' bytes',7,0);
         end;
         MaxLines:=a-1;
         freemem(tmpStr,16384);
    end;

    procedure ShowAllText;
    var x,y,len:word;s:string;
    begin
         for y:=0 to 23 do begin
          s:='';
          if LStr[y+Yscrlpos]<>NIL then begin
             len:=LStr[y+Yscrlpos]^.StrLen;
            if len>XscrlPos then begin
             dec(len,XScrlPos);
             if len>80 then len:=80;
             move(LStr[y+Yscrlpos]^.Str[XScrlPos],s[1],len);
             s[0]:=chr(len);
            end;
          end;
          while s[0]<#80 do s:=s+' ';
          OutString(0,y,s,11,0);
         end;
    end;

    procedure ScrollDown;
    begin
         if YScrlPos>=(MAxLines-23) then exit;
         inc(YScrlPos);
         ShowAllText;
    end;

    procedure ScrollUp;
    begin
         if YScrlPos<1 then exit;
         dec(YScrlPos);
         ShowAllText;
    end;

    procedure ScrollRight;
    begin
         inc(XScrlPos);
         ShowAllText;
    end;

    procedure ScrollLeft;
    begin
         if XScrlPos<1 then exit;
         dec(XScrlPos);
         ShowAllText;
    end;

    procedure InsertChar(ch:char);
    var l1,add:word;
    begin
         inc(CrX,XScrlPos);
         l1:=LStr[CrY+YscrlPos]^.StrLen;
         if (CrX+1)<=l1 then add:=1 else add:=(crx+1)-l1;

         getmem(TmpStr,l1+add);
         move(LStr[CrY+YscrlPos]^.Str,TmpStr^,l1);
         if (CrX+1)<=l1 then move(TmpStr^[CrX],TmpStr^[CrX+1],l1-crx) else
         fillchar(TmpStr^[l1],crx-l1,32);
         TmpStr^[Crx]:=ch;

         freemem(LStr[CrY+YscrlPos],2+l1);
         getmem(LStr[CrY+YscrlPos],2+l1+add);

         move(TmpStr^,LStr[CrY+YscrlPos]^.Str,l1+add);
         LStr[CrY+YscrlPos]^.StrLen:=l1+add;

         freemem(TmpStr,l1+add);
         dec(CrX,XScrlPos);

         if CrX=79 then ScrollRight else inc(CrX);
         ShowAllText;
         gotoxy(CrX+1,CrY+1);
    end;

    procedure DeleteLine(Lpos:byte);
    var y,l1,l2:word;
    begin
         l1:=LStr[Lpos-1]^.StrLen;
         l2:=LStr[Lpos]^.StrLen+l1;
         getmem(TmpStr,l2);

         move(LStr[Lpos-1]^.Str,TmpStr^,l1);
         move(LStr[Lpos]^.Str,TmpStr^[l1],Lstr[Lpos]^.StrLen);
         freemem(LStr[Lpos-1],l1+2);
         getmem(LStr[Lpos-1],l2+2);
         move(TmpStr^,LStr[Lpos-1]^.Str,l2);
         LStr[Lpos-1]^.StrLen:=l2;

         dec(MaxLines);
         freemem(Lstr[Lpos],LStr[Lpos]^.StrLen+2);
         for y:=Lpos to MaxLines do LStr[y]:=Lstr[y+1];
         LStr[MaxLines+1]:=NIL;
         freemem(TmpStr,l2);

         if CrY=0 then ScrollUp else begin dec(CrY);ShowAllText;end;
         Crx:=l1;
         gotoxy(CrX+1,CrY+1);
    end;

    procedure DeleteChar;
    var l1:word;
    begin
         inc(CrX,XScrlPos);
         if Crx=0 then begin
            DeleteLine(Cry+YscrlPos);
            exit;
         end;
         l1:=LStr[CrY+YscrlPos]^.StrLen;

         getmem(TmpStr,l1);
         move(LStr[CrY+YscrlPos]^.Str,TmpStr^,l1);
         move(TmpStr^[CrX],TmpStr^[CrX-1],l1-crx);

         freemem(LStr[CrY+YscrlPos],2+l1);
         getmem(LStr[CrY+YscrlPos],2+l1-1);

         move(TmpStr^,LStr[CrY+YscrlPos]^.Str,l1-1);
         LStr[CrY+YscrlPos]^.StrLen:=l1-1;

         freemem(TmpStr,l1);
         dec(CrX,XScrlPos);

         if CrX=0 then ScrollLeft else dec(CrX);
         ShowAllText;
         gotoxy(CrX+1,CrY+1);
    end;

    procedure InsertLine;
    var y,l1:word;
    begin
         inc(CrX,XScrlPos);
         inc(MaxLines);
         l1:=LStr[YscrlPos+CrY]^.StrLen;
         for y:=MaxLines-1 downto Yscrlpos+CrY+1 do LStr[y+1]:=Lstr[y];

         if (CrX>=l1)or(l1=0) then begin
            getmem(LStr[YscrlPos+CrY+1],2+1);
            LStr[YscrlPos+CrY+1]^.StrLen:=0;
         end else begin
            getmem(LStr[YscrlPos+CrY+1],2+(l1-crx));
            move(LStr[YscrlPos+CrY]^.Str[CrX],LStr[YscrlPos+CrY+1]^.Str,l1-crx);
            LStr[YscrlPos+CrY+1]^.StrLen:=l1-crx;

            getmem(TmpStr,crx+1);
            move(LStr[YscrlPos+CrY]^.Str,TmpStr^,crx);
            freemem(LStr[YscrlPos+CrY],2+l1);
            getmem(LStr[YscrlPos+CrY],2+crx);
            move(TmpStr^,LStr[YscrlPos+CrY]^.Str,crx);
            LStr[YscrlPos+CrY]^.StrLen:=crx;
            freemem(TmpStr,crx+1);
         end;
         dec(CrX,XScrlPos);

         XScrlPos:=0;
         ShowAllText;
         CrX:=0;
         if CrY=23 then ScrollDown else inc(CrY);
         gotoxy(CrX+1,CrY+1);
    end;

    {----- cursor control ------------------------------------------------------}

    procedure CursorDown;
    begin
         if Cry+YscrlPos>=MAxLines then exit;
         if CrY=23 then ScrollDown else inc(CrY);
         gotoxy(CrX+1,CrY+1);
    end;

    procedure CursorUp;
    begin
         if CrY=0 then ScrollUp else dec(CrY);
         gotoxy(CrX+1,CrY+1);
    end;

    procedure CursorRight;
    begin
         if CrX=79 then ScrollRight else inc(CrX);
         gotoxy(CrX+1,CrY+1);
    end;

    procedure CursorLeft;
    begin
         if CrX=0 then ScrollLeft else dec(CrX);
         gotoxy(CrX+1,CrY+1);
    end;

    procedure CursorAtLineEnd;
    begin
         CrX:=LStr[YscrlPos+CrY]^.StrLen;
         if CrX>79 then begin XScrlPos:=CrX-79;CrX:=79; end else begin
           if CrX>XScrlPos then dec(CrX,XScrlPos) else XScrlPos:=0;
         end;
         gotoxy(CrX+1,CrY+1);
         ShowAllText;
    end;

    procedure CursorAtLineStart;
    begin
         XScrlPos:=0;
         CrX:=0;
         gotoxy(1,CrY+1);
         ShowAllText;
    end;

    procedure PageDown;
    begin
         inc(YscrlPos,22);if yscrlpos>MaxLines-23 then Yscrlpos:=Maxlines-23;
         ShowAllText;
    end;

    procedure PageUp;
    begin
         dec(YscrlPos,22);if yscrlpos<0 then Yscrlpos:=0;
         ShowAllText;
    end;

    {----- status line ---------------------------------------------------------}

    procedure ShowStats;
    var s,s2,s3:string;
    begin
         str(CrY+YScrlPos+1,s);
         str(MaxLines+1,s2);
         s3:='  '+FName;
         if s3[0]>#40 then s3[0]:=#40;
         while s3[0]<#40 do s3:=s3+' ';

         s3:=s3+'Line: '+s+' / '+s2+'     Row: ';
         str(CrX+XScrlPos+1,s);
         str(LStr[YscrlPos+CrY]^.StrLen,s2);
         s3:=s3+s+' / '+s2;
         while s3[0]<#80 do s3:=s3+' ';

         OutString(0,24,s3,0,7);
    end;

    {----- main ----------------------------------------------------------------}

    begin

         FName:='test.doc';

         clrscr;
         XscrlPos:=0;YscrlPos:=0;CrX:=0;CrY:=0;

         LoadText(FName);
         ShowAllText;
         ShowStats;
         gotoxy(1,1);

    repeat
          repeat until keypressed;
          ch:=readkey;
          if ch=#0 then begin
             ch:=readkey;
             if ch=#80 then CursorDown;
             if ch=#72 then CursorUp;
             if ch=#77 then CursorRight;
             if ch=#75 then CursorLeft;
             if ch=#71 then CursorAtLineStart;
             if ch=#79 then CursorAtLineEnd;
             if ch=#81 then PageDown;
             if ch=#73 then PageUp;
             ShowStats;
          end else begin
            if ch<>#27 then
             if ch=#8 then DeleteChar else
              if ch=#13 then InsertLine else
                InsertChar(ch);
                ShowStats;
          end;
    until ch=#27;
    end.

[Back to TEXTEDIT SWAG index] [Back to Main SWAG index] [Original]