[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]