[Back to TEXTEDIT SWAG index] [Back to Main SWAG index] [Original]
{$B+} {Boolean complete evaluation on}
{$I+} {I/O checking on}
{$N-} {No numeric coprocessor}
{$R-} {Range checking off}
{$S-} {Stack checking on}
{$V-} {Var String checking off}
Uses Crt,Dos,Printer;
Const
MaxWidth = 128;
RtMrg : Integer = 76;
LeftM : Integer = 1;
Wrap : Boolean = True;
InSrt : Boolean = True;
GoodColorCard : Boolean = True; {set false for IBM CGA}
Type
Line = String[MaxWidth];
LPtr = ^LineRec;
LineRec = Record
Last : LPtr;
Data : Line;
Next : LPtr;
Clr : BYTE;
End;
ScreenLine = String[80];
String80 = String[80];
Word = String[24];
Var
LWord : ScreenLine; { left margin spacer }
Find ,Repl ,
InPut,OutPut : Word;
Fore , Back, Attr : Byte; { text colors for Write}
BaseOfScreen,Mode : LongInt; { used by FASTWRITE }
WaitforRetrace : Boolean; { " " " }
VidStatPort, VidModePort : LongInt; { " " " }
ModePortData : Byte Absolute $40 : $65; { }
SearchString,
Replacement : ScreenLine;
TextLine ,BlankLine : ScreenLine;
FileFound,
Finished ,Changed : Boolean;
TabSet : Array [1..MaxWidth] Of Boolean;
TextFile : Text;
WorkFile : Text;
Ln,LastLn,NextLn,
FirstLn,EndLn : LPtr;
MaxLines : Integer ;
IBeg , IEnd : Integer ;
BlockBeg, BlockEnd : LPtr;
I , J, {cursor position: i = line, j = column}
Len, {length of current line}
NLines, {length of file}
NBl, {number of buffer lines}
Top, {first line on screen}
Offset, K, N : Integer;
Choice, Ch : Char;
(*-------------------------------------------------------------------*)
Function YN: Boolean;
Begin
Repeat
Ch := ReadKey
Until Ch In['y','Y','n','N'];
If UpCase(Ch) = 'Y' Then
YN := True
Else YN := False;
End;
Procedure Beep;
Begin
Sound(800);
Delay(400);
NoSound;
Delay(1000);
End;
Procedure Capitalize(var fname:word);
Begin
For J := 1 To Length(FName) Do
FName[J] := UpCase(FName[J]);
End;
Procedure ReadFile;
Var OvFlw : Boolean;
InputLine : String[255];
Begin
If ParamStr(1) = '' Then
Begin
Write('File to edit: ');
ReadLn(Input);
End
Else
InPut := ParamStr(1);
Capitalize(Input);
New(Ln);
Ln^.Data := '';
FirstLn := Ln;
EndLn := Ln;
Assign(WorkFile,Input);
{$I-} ReSet(WorkFile); {I+}
If IoResult = 0 Then
Begin
OvFlw := False;
MaxLines := MemAvail Div 12;
If MaxLines < 0 Then
MaxLines := 2730;
NLines := 0;
Write(' Reading file ');
While Not (Eof(WorkFile) Or OvFlw) Do
Begin
ReadLn(WorkFile,InputLine);
If Length(InputLine) > MaxWidth Then
Begin
WriteLn('File is too fat for this editor');
OvFlw := True; Delay(1000);
End
Else
Begin
Ln^.Data := InputLine;
LastLn := Ln;
New(Ln);
Ln^.data := '';
Ln^.last := LastLn;
LastLn^.Next := Ln;
NLines := NLines + 1;
If NLines > MaxLines Then
Begin
WriteLn('File is too long. Not enough memory');
OvFlw := True; Delay(1000);
End;
End;
End; {not EOF}
EndLn := Ln;
If Not OvFlw Then
FileFound := True;
End {IOresult = 0}
Else
Begin
Write('Can''t find this file. Is this a new file?');
If YN Then
Begin
FileFound := True;
NLines := 1;
New(Ln);
Ln^.Data := '';
FirstLn^.Next := Ln;
Ln^.Last := FirstLn;
EndLn := Ln;
End
Else
FileFound := False;
End;
Close(WorkFile);
End;
Procedure WriteFile; { save changes to file }
Begin
GotoXY(1,1); For J := 1 To 45 Do Write(' ');
GotoXY(1,1); Write('Text was changed. Save? ');
If YN Then
Begin
Write('as: '); ReadLn(OutPut);
If OutPut = '' Then
OutPut := Input;
Capitalize(OutPut);
GotoXY(40,1); WriteLn(' Writing to disk as ',OutPut);
Assign(WorkFile,OutPut);
ReWrite(WorkFile);
Ln := EndLn^.Next;
Repeat
WriteLn(WorkFile,Ln^.Data);
Ln := Ln^.Next
Until Ln = EndLn;
Close(WorkFile);
End;
End;
{------------------------- FastWrite Routines -------------------------}
Function Attribute(Foreground, Background : Byte) : Byte;
{-Translates foreground and background colors into video attributes.
"And 127" masks out the blink bit. Add 128 to the result to set it.}
Begin
Attribute := ((Background Shl 4) + Foreground) And 127;
End;
Function EgaInstalled : Boolean;
{-Test for presence of the EGA. I have little idea how this works, but
it does.}
Begin
Inline(
$B8/$00/$12 { MOV AX,$1200}
/$BB/$10/$00 { MOV BX,$10}
/$B9/$FF/$FF { MOV CX,$FFFF}
/$CD/$10 { INT $10}
/$31/$C0 { XOR AX,AX}
/$81/$F9/$FF/$FF { CMP CX,$FFFF}
/$74/$01 { JE DONE}
/$40 { INC AX}
/$88/$46/$04 {DONE: MOV [BP+$04],AL}
);
End;
Procedure GetVideoMode;
{-Video mode of 7 indicates mono display; all other modes are for color
displays. This routine MUST be called before any of the screen writing
routines are used!}
Var
Mode : Integer;
Vid : Integer Absolute $40 : $63;
Begin
Inline(
$B4/$0F {MOV AH,$F}
/$CD/$10 {INT $10}
/$30/$E4 {XOR AH,AH}
/$89/$46/<Mode {MOV [BP+<Mode],AX}
);
If Mode = 6 Then Mode := 7;
If Mode = 7 Then BaseOfScreen := $B000 { Mono }
Else BaseOfScreen := $B800; { Color }
VidStatPort := Vid + 6; {video status port for either card}
VidModePort := Vid + 4; {video mode port for either card}
WaitForRetrace := (BaseOfScreen = $B800) And Not EgaInstalled;
{ *VERY IMPORTANT* WaitForRetrace MUST be false if BaseOfScreen = $B000. }
End;
Procedure VideoOff;
{-avoid snow writing full screen to c/g card}
Begin
{clear video enable bit}
Port[VidModePort] := ModePortData And 247;
End;
Procedure VideoOn;
{-reenable video}
Begin
{set video enable bit}
Port[VidModePort] := ModePortData Or 8;
End;
Procedure FastWrite( St : String80; Row, Col, Attr : Byte );
{-Write St directly to video memory, without snow.}
Begin
Inline(
$1E { PUSH DS ;Save DS}
/$31/$C0 { XOR AX,AX ;AX = 0}
/$88/$C1 { MOV CL,AL ;CL = 0}
/$8A/$AE/>Row { MOV CH,[BP+>Row] ;CX = Row * 256}
/$FE/$CD { DEC CH ;Row to 0..24 range}
/$D1/$E9 { SHR CX,1 ;CX = Row * 128}
/$89/$CF { MOV DI,CX ;Store in DI}
/$D1/$EF { SHR DI,1 ;DI = Row * 64}
/$D1/$EF { SHR DI,1 ;DI = Row * 32}
/$01/$CF { ADD DI,CX ;DI = (Row * 160)}
/$8B/$8E/>Col { MOV CX,[BP+>Col] ;CX = Column}
/$49 { DEC CX ;Col to 0..79 range}
/$D1/$E1 { SHL CX,1 ;Account for attribute bytes}
/$01/$CF { ADD DI,CX ;DI = (Row * 160) + (Col * 2)}
/$8E/$06/>BaseOfScreen { MOV ES,[>BaseOfScreen] ;ES:DI points to Base:Row,Col}
/$8A/$0E/>WaitForRetrace{ MOV CL,[>WaitForRetrace] ;Grab this before changing DS}
/$8C/$D2 { MOV DX,SS ;Move SS...}
/$8E/$DA { MOV DS,DX ; into DS}
/$8D/$B6/>St { LEA SI,[BP+>St] ;DS:SI points to St[0]}
/$FC { CLD ;Set direction to forward}
/$AC { LODSB ;AX = Length(St); DS:SI -> St[1]}
/$91 { XCHG AX,CX ;CX = Length; AL = Wait}
/$E3/$29 { JCXZ Exit ;If string empty, Exit}
/$8A/$A6/>Attr { MOV AH,[BP+>Attr] ;AH = Attribute}
/$D0/$D8 { RCR AL,1 ;If WaitForRetrace is False...}
/$73/$1D { JNC NoWait ; use NoWait routine}
/$BA/$DA/$03 { MOV DX,$03DA ;Point DX to CGA status port}
/$AC {Next: LODSB ;Load next character into AL}
{ ; AH already has Attr}
/$89/$C3 { MOV BX,AX ;Store video word in BX}
/$FA { CLI ;No interrupts now}
/$EC {WaitNoH: IN AL,DX ;Get 6845 status}
/$A8/$08 { TEST AL,8 ;Check for vertical retrace}
/$75/$09 { JNZ Store ; In progress? go}
/$D0/$D8 { RCR AL,1 ;Else, wait for end of}
/$72/$F7 { JC WaitNoH ; horizontal retrace}
/$EC {WaitH: IN AL,DX ;Get 6845 status again}
/$D0/$D8 { RCR AL,1 ;Wait for horizontal}
/$73/$FB { JNC WaitH ; retrace}
/$89/$D8 {Store: MOV AX,BX ;Move word back to AX...}
/$AB { STOSW ; and then to screen}
/$FB { STI ;Allow interrupts}
/$E2/$E8 { LOOP Next ;Get next character}
/$EB/$04 { JMP SHORT Exit ;Done}
/$AC {NoWait: LODSB ;Load next character into AL}
{ ; AH already has Attr}
/$AB { STOSW ;Move video word into place}
/$E2/$FC { LOOP NoWait ;Get next character}
/$1F {Exit: POP DS ;Restore DS}
);
End;
Procedure FastWriteV( Var St; Row, Col, Attr : Byte );
{-Works with string variables ONLY. (I made St an untyped parameter
only to make this easier to use when type checking is on.) This is
just FastWrite optimized for use with string Variables, for times
when speed really matters.}
Begin
Inline(
$1E { PUSH DS}
/$31/$C0 { XOR AX,AX}
/$88/$C1 { MOV CL,AL}
/$8A/$6E/<Row { MOV CH,[BP+<Row]}
/$FE/$CD { DEC CH}
/$D1/$E9 { SHR CX,1}
/$89/$CF { MOV DI,CX}
/$D1/$EF { SHR DI,1}
/$D1/$EF { SHR DI,1}
/$01/$CF { ADD DI,CX}
/$8B/$4E/<Col { MOV CX,[BP+<Col]}
/$49 { DEC CX}
/$D1/$E1 { SHL CX,1}
/$01/$CF { ADD DI,CX}
/$8E/$06/>BaseOfScreen { MOV ES,[>BaseOfScreen]}
/$8A/$0E/>WaitForRetrace{ MOV CL,[>WaitForRetrace]}
/$C5/$76/<St { LDS SI,[BP+<St] ;DS:SI points to St[0]}
/$FC { CLD}
/$AC { LODSB}
/$91 { XCHG AX,CX}
/$E3/$28 { JCXZ Exit}
/$8A/$66/<Attr { MOV AH,[BP+<Attr]}
/$D0/$D8 { RCR AL,1}
/$73/$1D { JNC NoWait}
/$BA/$DA/$03 { MOV DX,$03DA}
/$AC {Next: LODSB}
/$89/$C3 { MOV BX,AX}
/$FA { CLI}
/$EC {WaitNoH: IN AL,DX}
/$A8/$08 { TEST AL,8}
/$75/$09 { JNZ Store}
/$D0/$D8 { RCR AL,1}
/$72/$F7 { JC WaitNoH}
/$EC {WaitH: IN AL,DX}
/$D0/$D8 { RCR AL,1}
/$73/$FB { JNC WaitH}
/$89/$D8 {Store: MOV AX,BX}
/$AB { STOSW}
/$FB { STI}
/$E2/$E8 { LOOP Next}
/$EB/$04 { JMP SHORT Exit}
/$AC {NoWait: LODSB}
/$AB { STOSW}
/$E2/$FC { LOOP NoWait}
/$1F {Exit: POP DS}
);
End;
{------------------------- FastWrite Routines -------------------------}
Procedure RulerLine;
Var
C , J : Byte;
Begin
TextLine := BlankLine;
For J := 1 To 79 Do
Begin
If J Mod 5 = 0 Then
TextLine[J] := '+'
Else
TextLine[J] := '-';
C := 48 + ((J + Offset) Div 10) Mod 10 ;
If J Mod 10 = 0 Then
TextLine[J] := Chr(C);
End;
FastWriteV(TextLine,2,1, Attr);
If (Wrap) Then { put margin markers on ruler }
Begin
Textcolor(14);
TextBackGround(Green);
if LeftM >= Offset Then
Begin
GotoXY(LeftM - Offset + 1, 2);
Write('|');
End;
If RtMrg >= Offset Then
Begin
GotoXY(RtMrg - Offset + 1, 2);
Write('|');
End;
TextColor( Fore );
TextBackGround( Back );
End;
End;
Procedure StatusLine;
Begin
Textline := BlankLine;
Insert(' Line: Column:',TextLine,1);
If Insrt Then Insert('Insert ',TextLine,26)
Else Insert('OverWrite ',TextLine,25);
If Wrap Then Insert(' WordWrap',TextLine,35)
Else Insert(' NoWrap ',TextLine,35);
Insert(' Workfile:',TextLine,47);
Insert(Input,TextLine,58);
FastWriteV(TextLine,1,1,Attr);
RulerLine;
End;
Procedure WriteLine(Row,Attr:Byte); { direct write to screen }
Var Len : Byte; { writes blanks where there is no text}
Contents : ScreenLine;
Begin
TextLine := BlankLine;
Contents := Copy(Ln^.Data,Offset,80);
Len := Ord(Contents[0]);
Insert(Contents,TextLine,1);
If Len = 80 Then TextLine[80] := '+'
Else If Len > 0 Then TextLine[80] := '<';
FastWriteV(TextLine,Row,1,Attr);
End;
Procedure Screen; { rewrites the bottom 23 lines }
Var Row : Byte;
TopLn : LPtr;
Begin { makes sure i and ln are in register }
Ln := EndLn^.Next;
If Top > 1 Then
For K := 2 To Top Do
Ln := Ln^.Next;
TopLn := Ln;
For Row := 3 to 25 do
Begin
WriteLine(Row,Attr);
If Ln <> EndLn Then
Ln := Ln^.Next;
End;
Ln := TopLn;
Row := I - Top;
While Row > 0 do
Begin
Ln := Ln^.Next;
Row := Row - 1;
End;
End;
Procedure Help;
Begin
Window(1, 1, 80, 25);
ClrScr;
GetVideoMode;
FastWrite('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»', 1, 1, Attr );
FastWrite('º Window Editor -- by GDSOFT º', 2, 1, Attr );
FastWrite('º ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ º', 3, 1, Attr );
FastWrite('º ³ ^X line up ³ ³ ^S column left ³ ³ Alt-A Ascii ³ º', 4, 1, Attr );
FastWrite('º ³ ^E line down ³ ³ ^D column right ³ ³ Alt-B Back Color ³ º', 5, 1, Attr );
FastWrite('º ³ ^C page up ³ ³ ^PgUp file home ³ ³ Alt-C Copy Block ³ º', 6, 1, Attr );
FastWrite('º ³ ^R page down ³ ³ ^PgDn file end ³ ³ Alt-D Del Block ³ º', 7, 1, Attr );
FastWrite('º ³ ^K quit ³ ³ ^N insert line ³ ³ Alt-F Fore Color ³ º', 8, 1, Attr );
FastWrite('º ³ ^P set margins ³ ³ ^Y delete line ³ ³ Alt-G Goto Block ³ º', 9, 1, Attr );
FastWrite('º ³ ^BkSp delete word ³ ³ BkSp delete char ³ ³ Alt-M Move Block ³ º',10, 1, Attr );
FastWrite('º ³ ^V toggle ins ³ ³ Ins toggle insert ³ ³ Alt-N Clr Marks ³ º',11, 1, Attr );
FastWrite('º ³ ^W window dn ³ ³ ³ ³ Alt-S Beg Block ³ º',12, 1, Attr );
FastWrite('º ³ ^Z window up ³ ³ Del delete char ³ ³ Alt-T End Block ³ º',13, 1, Attr );
FastWrite('º ³ ^Home erase bol ³ ³ Home beg of line ³ ³ ³ º',14, 1, Attr );
FastWrite('º ³ ^End erase eol ³ ³ End end of line ³ ³ SPELLING CHECK ³ º',15, 1, Attr );
FastWrite('º ³ ^F next word ³ ³ Tab next tab stop ³ ³ Alt-0 Document ³ º',16, 1, Attr );
FastWrite('º ³ ^A prev word ³ ³ BTab last tab stop ³ ³ Alt-1 Word ³ º',17, 1, Attr );
FastWrite('º ³ F1 help ³ ³ F6 replace ³ ³ ³ º',18, 1, Attr );
FastWrite('º ³ F2 clear marks ³ ³ F7 page up ³ ³ ³ º',19, 1, Attr );
FastWrite('º ³ F3 quit ³ ³ F8 page down ³ ³ ³ º',20, 1, Attr );
FastWrite('º ³ F4 set margins ³ ³ F9 prev word ³ ³ ³ º',21, 1, Attr );
FastWrite('º ³ F5 search ³ ³ F10 next word ³ ³ ³ º',22, 1, Attr );
FastWrite('º ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ º',23, 1, Attr );
FastWrite('º Press any key to return to your editing..... º',24, 1, Attr );
FastWrite('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ',25, 1, Attr );
Repeat
Until KeyPressed;
Ch := ReadKey;
StatusLine;
Screen;
End;
Procedure PageUp;
Begin
If Top > 22 Then Begin
Top := Top - 22; I := I - 22; End
Else Begin
I := I - Top + 1; Top := 1; End;
Screen;
End;
Procedure PageDown;
begin
If Top <= (NLines - 44) Then
Begin
Top := Top + 22;
I := I + 22;
End
Else If NLines > 22 Then
Begin
I := I - Top + NLines - 22;
Top := NLines - 22;
End;
Screen;
End;
Procedure Cursor; { make sure the cursor is visible on the screen }
Var ii,jj,chgd : Word;
Shifted : Boolean;
Begin
Shifted := False;
If I < 1 Then
Begin
I := 1;
Ln := EndLn^.Next;
End;
If I > NLines Then
Begin
I := NLines;
Ln := EndLn^.Last;
End;
If J < 1 Then
J := 1;
If J > MaxWidth Then
J := MaxWidth;
Len := Ord(Ln^.Data[0]);
If ( J > Offset + 77 ) Then
Begin
Offset := 10 * ( J Div 10 ) - 59;
Shifted := True;
End;
If J < Offset Then
Begin
Offset := 10 * ( ( J - 10 ) Div 10 ) + 1;
Shifted := True;
End;
If I < Top Then
Begin
Top := I;
Shifted := True;
End;
If I > Top + 22 Then
Begin
Top := I - 22;
Shifted := True;
End;
If Shifted Then
Begin
RulerLine;
Screen;
End;
Str(i:4,ii);
Str(j:3,jj);
If Changed Then Chgd := ' * '
Else Chgd := ' ';
FastWriteV(ii,1,7,Attr); GetVideoMode;
FastWriteV(jj,1,20,Attr); GetVideoMode;
FastWriteV(Chgd,1,76,Attr); GetVideoMode;
GotoXY( J - Offset + 1, i - top + 3);
End;
Procedure CursorLeft;
Begin
J := J - 1;
If J < 1 Then
Begin
I := I - 1;
If I < 1 Then
Begin
I := 1;
J := 1;
Ln := EndLn^.Next ;
Exit;
End;
J := Length(Ln^.Last^.Data) + 1 ;
Ln := Ln^.Last ;
End
End;
Procedure CursorRight;
Begin
j := j + 1;
if j > MaxWidth then
Begin
i := i + 1;
If I > NLines then
Begin
I := NLines;
Ln := EndLn^.Last ;
End
Else If I < NLines Then
Ln := Ln^.Next ;
J := 1;
End;
End;
Procedure ParaForm; { set margins, wordwrap on/off }
Begin
GotoXY(1,1); ClrEol;
Write('WordWrap? ');
If YN Then
Wrap := True
Else
Begin
Wrap := False;
LeftM := 1;
LWord := '';
End;
If Wrap Then
Begin
GotoXY(15,1); Write('Left margin: ');
ReadLn(LeftM);
LWord := '';
While Length(LWord) < LeftM - 1 Do
LWord := LWord + ' ';
RulerLine;
Repeat
GotoXY(35,1); Write('Right margin: ');
ReadLn(RtMrg);
Until RtMrg > LeftM + 24;
End;
ClrScr;
StatusLine;
Screen;
End; { ParaForm }
Procedure InsertLn(contents:line); {insert after current line}
Begin
New(NextLn);
NextLn^.Data := Contents;
NextLn^.Last := Ln;
NextLn^.Next := Ln^.Next;
Ln^.Next^.Last := NextLn;
Ln^.Next := NextLn;
NLines := NLines + 1;
End;
Procedure CutLine; { start new line after <CR> }
Var
More : Line;
Begin
More := Copy(Ln^.Data,J,Len-J+1);
Delete(Ln^.Data,J,Len-J+1);
InsertLn(LWord + More);
i := i + 1;
j := LeftM;
Screen;
End;
Procedure WordWrap;
Begin
N := 0;
Repeat
J := J - 1;
N := N + 1;
Until (Ln^.Data[J] = ' ') Or (J = 1);
J := J + 1;
Len := Len + 1;
CutLine;
J := LeftM + N - 1 ;
end;
Procedure StackLine; { put current line on top of previous line }
begin
j := length(ln^.last^.data)+1;
ln^.last^.data := ln^.last^.data + ln^.data;
ln^.last^.next := ln^.next; { isolate current line }
ln^.next^.last := ln^.last;
Dispose(Ln); { and zap it}
I := I - 1;
NLines := NLines - 1;
Screen;
End;
Procedure DeleteLine;
Begin
Ln^.Last^.Next := Ln^.Next; { isolate current line }
Ln^.Next^.Last := Ln^.Last;
Dispose(Ln); { and zap it}
J := 1 ; I := I - 1;
NLines := NLines - 1;
Changed := True;
StatusLine;
Screen;
End;
Procedure DeleteEOL;
Begin
If J < MaxWidth Then
Begin
Ln^.Data := Copy ( Ln^.Data, 1 , J - 1 ) ;
Changed := True;
End;
If J > 1 Then
J := J - 1;
StatusLine ;
Screen ;
End;
Procedure DeleteBOL;
Begin
If J > 1 Then
Begin
Ln^.Data := Copy ( BlankLine, 1, J ) + Copy ( Ln^.Data, J + 1 , MaxWidth ) ;
Changed := True;
End;
If J < MaxWidth Then
J := J + 1;
StatusLine ;
Screen ;
End;
Procedure DeleteWord;
Var
EndW : Byte;
Begin
While (( Copy(Ln^.Data,J,1) <> ' ' ) And ( J > 0 )) Do
J := J - 1 ;
If J = 0 Then
J := 1 ;
EndW := J + 1;
While (( Copy(Ln^.Data,EndW,1) <> ' ' ) And ( EndW < MaxWidth )) Do
EndW := EndW + 1 ;
If J = 1 Then
Ln^.Data := Copy ( Ln^.Data , EndW + 1, MaxWidth )
Else
Ln^.Data := Copy ( Ln^.Data, 1, J ) + Copy ( Ln^.Data , EndW + 1, MaxWidth ) ;
Changed := True ;
StatusLine ;
Screen ;
End;
Procedure PrevWord;
Begin
(* if i am in a word then skip to the space *)
While (Not ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) ))) And
(( i <> 1 ) Or ( j <> 1 )) Do
CursorLeft;
(* find end of previous word *)
While ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) )) And
(( i <> 1 ) Or ( j <> 1 )) Do
CursorLeft;
(* find start of previous word *)
While (Not ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) ))) And
(( i <> 1 ) Or ( j <> 1 )) do
CursorLeft;
CursorRight;
End;
Procedure NextWord;
Begin
(* if i am in a word, then move to the whitespace *)
while (not ((Ln^.Data[j] = ' ') or ( j >= length(Ln^.Data)))) and
( i < NLines ) do
CursorRight;
(* skip over the space to the other word *)
while ((Ln^.Data[j] = ' ') or ( j >= Length(Ln^.Data))) and
( i < NLines ) do
CursorRight;
End;
Procedure Tab;
Begin
If J < MaxWidth Then
Begin
Repeat
J := J + 1;
Until ( TabSet [J]= True ) Or ( J = MaxWidth );
End;
End;
Procedure BackTab;
Begin
If J > 1 Then
Begin
Repeat
J := J - 1;
Until ( TabSet [J]= True ) Or ( J = 1 );
End;
End;
Procedure Search;
var
Temp : ScreenLine;
Pointer, Position : Integer;
LocPtr , Location : Integer;
TmpPtr : LPtr;
Begin
Window(1, 1, 80, 25);
GotoXY(1, 1); ClrEol;
Write('Search: Enter string: <',SearchString,'> ');
Temp := '';
ReadLn(Temp);
If Temp <> '' Then
SearchString := Temp;
If Length( SearchString ) = 0 Then
Begin
StatusLine;
Screen;
Exit;
End;
GotoXY(1,1); ClrEol;
Write('Searching...');
NextWord;
TmpPtr := Ln;
LocPtr := J;
For Location := I + 1 To NLines Do
begin
(* look for matches on this line *)
Pointer := Pos (SearchString, Copy(Ln^.Data,LocPtr,MaxWidth));
(* if there was a match then get ready to print it *)
If (Pointer > 0) Then
Begin
I := Location - 1 ;
J := Pointer;
StatusLine;
Screen;
Exit;
End
Else If Location <> NLines Then
Begin
Ln := Ln^.Next ;
LocPtr := 1 ;
End
End;
Window(1, 1, 80, 25);
GotoXY(1, 1); ClrEol;
Write('Search string not found. Press any key to exit...');
Repeat
Until KeyPressed;
Ch := ReadKey;
Ln := TmpPtr ;
StatusLine;
Screen;
End;
Procedure Replace;
Var
Temp : ScreenLine;
Pointer , Position : Integer;
Location, Len : Integer;
Begin
Window(1, 1, 80, 25);
GotoXY(1, 1); ClrEol;
Write('Replace: Enter search string: <',SearchString,'> ');
Temp := '';
ReadLn(Temp);
If Temp <> '' Then
SearchString := Temp;
If Length(SearchString) = 0 Then
Begin
StatusLine;
Screen;
Exit;
End;
GotoXY(1, 1); ClrEol;
Write('Replace: Enter replacement string: <',replacement,'> ');
Temp := '';
ReadLn(Temp);
if Temp <> '' Then
Replacement := Temp;
Len := Length (Replacement);
Ln := EndLn^.Next ;
I := 1 ; J := 1 ;
GotoXY(1, 1); ClrEol;
Write('Searching...');
For Location := 1 to NLines Do
Begin
(* look for matches on this line *)
Position := Pos (SearchString, Ln^.Data );
(* if there was a match then get ready to print it *)
While (Position > 0) Do
Begin
I := Location ;
J := Position ;
If Location > 8 Then
Top := Location - 8
Else
Top := 1 ;
Screen ;
TextColor( Back );
TextBackGround( Fore );
GotoXY( J - Offset + 1, I - Top + 3 );
Write ( SearchString );
TextColor( Fore );
TextBackGround( Back );
GotoXY(1, 1); ClrEol;
Write('Replace (Y/N/ESC)? ');
Ch := ReadKey;
If Ord (Ch)= 27 Then
Begin
I := 1;
J := 1;
Ln := EndLn^.Next ;
StatusLine;
Screen;
Exit;
End;
If Ch In ['y','Y'] Then
Begin
Ln^.Data := Copy (Ln^.Data, 1, Position - 1) + Replacement +
Copy (Ln^.Data, Position + Length (SearchString), MaxWidth);
Position := Pos (SearchString, Copy (Ln^.Data, Position + Len + 1,MaxWidth)) ;
End
Else
Position := Pos (SearchString, Copy (Ln^.Data, Position + Length(SearchString) + 1,MaxWidth)) ;
End;
Ln := Ln^.Next ;
GotoXY(1, 1); ClrEol;
Write('Searching...');
End;
Window(1, 1, 80, 25);
GotoXY(1, 1); ClrEol;
Write('End of replace. Press any key to exit...');
Repeat
Until KeyPressed;
Ch := ReadKey;
Ln := EndLn^.Next ;
I := 1 ;
J := 1 ;
StatusLine;
Screen;
End;
Procedure ClearMarks ;
Begin
IBeg := 0 ;
IEnd := 0 ;
BlockBeg := Nil ;
BlockEnd := Nil ;
End;
Procedure InsertMark( Mark : Char );
Begin
If Mark = 'B' Then
Begin
If BlockBeg = Nil Then
Begin
BlockBeg := Ln ;
IBeg := I ;
End
Else { BlockBeg Already Defined }
Write(#7);
End;
If Mark = 'E' Then
Begin
If BlockEnd = Nil Then
Begin
BlockEnd := Ln ;
IEnd := I ;
End
Else { BlockEnd Already Defined }
Write(#7);
End;
End;
Procedure GotoBlock ;
Begin
If BlockBeg <> Nil Then
Begin
Ln := BlockBeg ;
I := IBeg;
J := 1 ;
If ( I >= 12 ) Then
Top := I - 8;
StatusLine ;
Screen ;
End;
End;
Procedure DeleteBlock;
Var
TPtr : LPtr;
Begin
If IEnd < IBeg Then
Exit;
Ln := BlockEnd ;
I := IEnd ;
Repeat
TPtr := Ln^.Last; { save location of previous line }
Ln^.Last^.Next := Ln^.Next; { isolate current line }
Ln^.Next^.Last := Ln^.Last;
Dispose(Ln); { and zap it}
J := 1 ; I := I - 1;
NLines := NLines - 1;
Ln := TPtr;
Until Ln = BlockBeg^.Last ;
If I >= 12 Then
Top := I - 8
Else
Top := 1 ;
Changed := True;
ClearMarks;
StatusLine;
Screen;
End;
Procedure CopyBlock;
var
TPtr : LPtr ;
Size : Integer;
Begin
If IEnd < IBeg then
Exit;
If (IBeg < I) And (I <= IEnd) Then
Exit;
Size := IEnd - IBeg - 1; { exclude markers }
If Size = 0 Then
Exit;
If NLines + Size <= MaxLines Then
Begin
Repeat
InsertLn (BlockEnd^.Data) ;
BlockEnd := BlockEnd^.Last ;
NLines := NLines + 1 ;
Until BlockEnd = BlockBeg^.Last ;
End
Else
Write(#7);
Changed := True;
ClearMarks;
StatusLine;
Screen;
End;
Procedure MoveBlock;
Var
Size : Integer;
TPtr : LPtr;
Begin
If IEnd < IBeg Then
Exit;
If (IBeg <= I) And (I <= IEnd + 1) Then
Exit;
Size := IEnd - IBeg + 1;
If NLines + Size <= MaxLines Then
Begin
TPtr := Ln^.Next ;
BlockBeg^.Last^.Next := BlockEnd^.Next ;
BlockEnd^.Next^.Last := BlockBeg^.Last ;
Ln^.Next := BlockBeg ;
TPtr^.Last := BlockEnd ;
BlockBeg^.Last := Ln ;
BlockEnd^.Next := TPtr ;
End
Else
Write(#7);
Changed := True;
ClearMarks;
StatusLine;
Screen;
End;
Procedure WriteBlock ;
Var
TPtr : LPtr ;
Begin
If ((BlockBeg = Nil) Or (BlockEnd = Nil)) Then
Exit ;
If IBeg + 1 < IEnd Then
Begin
GotoXY(1,1); For J := 1 To 45 Do Write(' ');
GotoXY(1,1); Write('Write Block To Disk ? ');
If YN Then
Begin
Write('as: '); ReadLn(OutPut);
If OutPut = '' Then
OutPut := Input;
Capitalize(OutPut);
GotoXY(40,1); WriteLn(' Writing to disk as ',OutPut);
Assign(WorkFile,OutPut);
ReWrite(WorkFile);
TPtr := BlockBeg;
Repeat
WriteLn(WorkFile,TPtr^.Data);
TPtr := TPtr^.Next
Until TPtr = BlockEnd;
Close(WorkFile);
End;
End
Else
Write(#7);
StatusLine ;
Screen ;
End;
Procedure AddChar; { keyboard entry }
begin
Changed := True;
While J > Len + 1 Do
Begin
Ln^.Data := Ln^.Data + ' ' ;
Len := Len + 1 ;
End;
If J = Len + 1 Then
Ln^.Data := Ln^.Data + Ch
Else If InSrt Then
Insert(Ch,Ln^.Data,J)
Else
Ln^.Data[J] := Ch;
J := J + 1;
WriteLine( I - Top + 3,Attr);
If (J > RtMrg + 2) And Wrap Then
WordWrap;
End;
Procedure Ascii;
Var
AscNo, Repeats, R : Integer;
AsciiLine : ScreenLine;
Begin
AsciiLine := '';
GotoXY( 1, 1); ClrEol;
Write('Enter ASCII code number: --- ');
GotoXY(26,1);
Readln(AscNo);
GotoXY(1,1);
Write('Enter number of repeats: -- ');
GotoXY(26,1);
ReadLn(Repeats);
If Not(Repeats In [1..79]) Then
Repeats := 1;
If (AscNo > 0) And (AscNo < 256) Then
Begin
For R := 1 To Repeats Do
Begin
Ch := Chr(AscNo);
AsciiLine := AsciiLine + Ch ;
End;
End;
While J > Length(Ln^.Data) + 1 Do
Begin
Ln^.Data := Ln^.Data + ' ' ;
Len := Len + 1 ;
End;
J := J - 1;
If J = Length(Ln^.Data) + 1 Then
Ln^.Data := Ln^.Data + AsciiLine
Else If InSrt Then
Insert(AsciiLine,Ln^.Data,J)
Else
Ln^.Data := Copy(Ln^.Data,1,J) + AsciiLine + Copy(Ln^.Data,J + Length(AsciiLine),128);
Changed := True;
StatusLine;
Screen;
End;
Procedure Leave;
Var
Trash : Char;
Begin
VideoOff;
Repeat
Until KeyPressed;
Trash := ReadKey;
If (Trash = #0) And (KeyPressed) Then
Trash := ReadKey;
VideoOn;
End;
Procedure Colors;
Begin
Case Ch Of
#48 : Back := (Back + 1) Mod 8;
#33 : Fore := (Fore + 1) Mod 16;
End;
Attr := Attribute( Fore, Back );
StatusLine;
Screen;
End;
Procedure Command;
Begin
If Ch = #0 Then
If KeyPressed Then Ch := ReadKey; { keypad input }
Case Ch Of
{alt 1} 'x' : Begin
{ do something useful here }
End;
{alt A} #30 : Ascii;
{alt B, alt F} #48,#33 : If Mode <> 7 Then Colors;
{alt C} #46 : CopyBlock;
{alt D} #32 : DeleteBlock;
{alt G} #34 : GotoBlock;
{alt H} #35 : Help;
{alt K} #37 : ;
{alt L} #38 : Leave;
{alt M} #50 : MoveBlock;
{alt N} #49 : ClearMarks;
{alt S} #31 : InsertMark('B');
{alt T} #20 : InsertMark('E');
{alt W} #17 : WriteBlock;
{alt X} #45 : Finished := True;
{tab} #9 : Tab;
{bktab} #15 : BackTab;
{F1} #59 : Help;
{F2} #60 : ClearMarks;
{F3} #61 : Finished := True;
{F4} #62 : ParaForm ;
{F5} #63 : Search ;
{F6} #64 : Replace;
{F7} #65 : PageUp ;
{F8} #66 : PageDown;
{F9} #67 : PrevWord;
{F10} #68 : NextWord;
{home} #71 : J := LeftM;
{end } #79 : J := Len + 1;
{^home} #119 : DeleteBOL;
{^end } #117 : DeleteEOL;
{^A} #116,#1 : PrevWord;
{^D} #77, #4 : J := J + 1;
{^S} #75,#19 : If J > 1 Then
J := J - 1;
{^E} #72, #5 : If I > 1 Then
Begin
I := I - 1;
Ln := Ln^.Last;
End;
{^F} #115,#6 : NextWord;
{^X} #80,#24 : If I < NLines Then
Begin
I := I + 1;
Ln := Ln^.Next;
End;
{del}#83, #7 : Begin
Delete(Ln^.Data,J,1);
WriteLine(I - Top + 3,Attr);
End;
{ <-- } #8 : If J = 1 Then
StackLine
Else
Begin
J := J - 1;
Delete(Ln^.Data,J,1);
Cursor;
WriteLine(i - Top + 3,Attr);
End;
{^<--} #127 : DeleteWord;
{Enter} #13 : Begin
If InSrt Then
Begin
If J = Len Then
J := J + 1;
CutLine;
End
Else
Begin
I := I + 1 ;
J := 1 ;
Ln^ := Ln^.Next^
End;
End;
{^R} #73,#18 : PageUp;
{^C} #81, #3 : PageDown;
{^PgUp} #132 : Begin
I := 1;
Top := 1;
Ln := FirstLn;
Screen;
End;
{^PgDn} #118 : Begin
I := NLines;
Top := NLines - 22;
Ln := EndLn;
Screen;
End;
{^Y} #25 : DeleteLine;
{^N} #14 : Begin
Ln := Ln^.Last;
InsertLn('');
Screen;
End;
{Ins}#22,#82 : Begin
If InSrt Then
InSrt := False
Else
InSrt := True;
StatusLine;
End;
{^P} #16 : ParaForm;
{^W} #23 : If Top > 1 Then
Begin
Top := Top - 1;
I := I - 1;
Screen;
End;
{^Z} #26 : If Top < NLines + 22 Then
Begin
Top := Top + 1;
I := I + 1;
Screen;
End;
{^K} #27,#11 : Finished := True;
Else Begin
GotoXY(1,1); WriteLn('****** COMMAND NOT RECOGNIZED ****** ');
Beep; StatusLine;
End;
End; {case}
End;
Begin {Main}
CheckBreak := TRUE;
DirectVideo := TRUE;
ClearMarks ;
GetVideoMode;
IF BaseOfScreen = $B000 Then
Begin
Fore := White;
Back := Black;
End
Else Begin
Fore := White; { make these whatever you want }
Back := Black;
End;
Attr := Attribute( Fore, Back );
TextColor( Fore );
TextBackground( Back );
ClrScr;
BlankLine := '';
For J := 1 To 80 Do
BlankLine := BlankLine + ' ';
For I := 1 To MaxWidth Do
TabSet[I]:=( I Mod 8 ) = 1;
FileFound := False;
ReadFile;
If FileFound Then Begin
FirstLn^.Last := EndLn ;
EndLn^.Next := FirstLn ; { close chain, endless loop }
J := 1; I := 1 ;
Top := 1; Offset := 1 ;
Find := '.'; Repl := '';
Nbl := 0; Lword := '';
SearchString := ''; Finished := False;
Replacement := ''; Changed := False;
ClrScr;
StatusLine;
Screen;
Repeat
Cursor;
Ch := ReadKey;
Case Ch Of
#0..#31,#127 : Command;
Else AddChar;
End;
Until Finished;
If Changed Then WriteFile;
End; {FileFound}
TextAttr := 7;
ClrScr;
End.
[Back to TEXTEDIT SWAG index] [Back to Main SWAG index] [Original]