Category : Pascal Source Code
Archive   : GSDB21.ZIP
Filename : GS_EDIT.PAS

Unit GS_Edit;
interface
uses
CRT,
Dos,
GS_KeyI,
GS_Scrn,
GS_Wind,
GS_Error,
GS_Strng;
type
GS_Edit_Pntr = ^GS_Edit_Line;
GS_Edit_Line = record
Next_Line,
Prev_Line : GS_Edit_Pntr;
Return_Cod : byte;
Line_Size : integer;
Valu_Line : string;
end;

GS_Edit_Blok = record
Blok_Line,
Blok_Colm : integer;
end;

GS_Edit_Objt = object
First_Line,
End_Line,
Work_Line : GS_Edit_Pntr;
{Used to track lines}
Cursor_LocX,
Cursor_LocY : word;
{Hold cursor location}
Active_Line, {Current line number}
Total_Lines, {Total number of lines}
Screen_Top, {Line number at top of screen}
Screen_Btm : longint;
{Line Number at bottom of screen}
CursorPos : integer;
{Position in line}
CursorLine : integer;
{Line currently working on}
Temp_Line : string;
{work area during wordwrap}
Edit_Lgth : integer;
{Max size of eaach line}
Lines_Avail : integer;
{Number of lines that will fit in the}
{window on the screen}
Ch_Work : char;
{Hold area for keystrokes}
Word_Wrap : boolean;
{True sets word wrap on}
WW_Flag : boolean;
{Internal flag for wordwrap condition}
Blok_Begin,
Blok_Fini : GS_Edit_Blok;
{Future use for block operations}


function Byte_Count : longint;
procedure Check_Func_Keys;
procedure Clear_Editor;
procedure Edit;
Procedure Edit_Line;
function Find_Line(linenum : integer) : boolean;
function Get_Line_Mem(lth : integer) : pointer;
constructor Init;
Procedure Rel_Line_Mem(linenum : integer);
Procedure Show_Lines(b, e :integer);
Procedure View;
Procedure WordWrap(Fline : string);
Procedure Pressed_Bsp;
Procedure Pressed_CrtlY;
Procedure Pressed_Del;
Procedure Pressed_DnAr;
Procedure Pressed_F1;
Procedure Pressed_Ret;
Procedure Pressed_UpAr;
Procedure Pressed_PgUp;
Procedure Pressed_PgDn;
end;


implementation
var
StatWin,
HelpWin,
EditWin : GS_Wind_Objt;

function GS_Edit_Objt.Byte_Count : longint;
var
i : longint;
p : GS_Edit_Pntr;
begin
i := 0;
p := First_Line;
while (p <> nil) do
begin
i := i + length(p^.Valu_Line) + 2;
{Add length of line + CR/LF chars}
p := p^.Next_Line;
end;
inc(i); {Add one for EOF byte}
Byte_Count := i;
end;

procedure GS_Edit_Objt.Clear_Editor;
begin
Work_Line := First_Line;
while (Work_Line <> nil) do
begin
End_Line := Work_Line^.Next_Line;
FreeMem(Work_Line,Work_Line^.Line_Size);
Work_Line := End_Line;
end;
First_Line := nil;
End_Line := nil;
Work_Line := nil;
Active_line := 0;
Total_Lines := 0;
end;


constructor GS_Edit_Objt.Init;
begin
First_Line := nil;
End_Line := nil;
Work_Line := nil;
Word_Wrap := true;
WW_Flag := false;
Active_Line := 0;
Total_Lines := 0;
Screen_Top := 0;
Screen_Btm := 0;
Ch_Work := #0;
CursorPos := 1;
CursorLine := 1;
Temp_Line := '';
GS_KeyI_Ins := True; {Start in insert mode}
Edit_Lgth := 32;
StatWin.InitWin(1,23,80,25,Yellow,Black,LightGray,Black,LightGray,
true,'',true);
EditWin.InitWin(1,1,80,22,LightGray,Black,LightGray,Black,LightGray,
false,'',true);
HelpWin.InitWin(29,2,51,20,Yellow,Black,Yellow,Black,LightGray,
true,'[ Edit Help ]',true);
end;


procedure GS_Edit_Objt.Pressed_F1;
var
cc : char;
begin
HelpWin.SetWin;
writeln('Toggle Ins - Ins');
writeln('Delete Char - Del');
writeln('Delete Line - Ctl-Y');
writeln('Press any Key');
cc := ReadKey;
if cc = #0 then cc := ReadKey;
HelpWin.RelWin;
end;


procedure GS_Edit_Objt.Pressed_Bsp;
var
bb : byte;
ss : string;
ll : boolean;
begin
if CursorPos > 1 then
begin
Delete(Work_Line^.Valu_Line, Pred(CursorPos), 1);
GoToXY(1, CursorLine);
Write(Work_Line^.Valu_Line);
ClrEol;
Dec(CursorPos);
end
else
begin
if Active_Line > 1 then
begin
bb := Work_line^.Return_Cod;
ss := Work_Line^.Valu_Line;
if Active_Line < Total_Lines then
begin
Pressed_CrtlY;
Pressed_UpAr;
end else Pressed_CrtlY;
Work_Line^.Return_Cod := bb;
ss := Work_Line^.Valu_Line + ss;
CursorPos := length(Work_Line^.Valu_Line);
WordWrap(ss);
GotoXY(1,succ(Active_Line-Screen_Top));
write(Work_Line^.Valu_Line);
end;
end;
end;

procedure GS_Edit_Objt.Pressed_Del;
begin
if CursorPos <= Length(Work_Line^.Valu_Line) then
begin
Delete(Work_Line^.Valu_Line, CursorPos, 1);
GoToXY(1, CursorLine);
Write(Work_Line^.Valu_Line);
ClrEol;
end;
end;

procedure GS_Edit_Objt.Pressed_PgDn;
begin {Page Down}
Active_Line := pred(Screen_Top + Lines_Avail);
if Active_Line > Total_Lines then Active_Line := Total_Lines;
if not Find_Line(Active_Line) then
begin
ShowError(710,'Pressed_PgDn');
exit;
end;
if Active_Line <> Screen_Top then Show_Lines(Active_Line,Total_Lines);
CursorLine := 1;
if length(Work_Line^.Valu_Line)+1 < CursorPos then
CursorPos := length(Work_Line^.Valu_Line)+1;
end;

procedure GS_Edit_Objt.Pressed_PgUp;
begin {Page Up}
if Active_Line <= 1 then exit;
Active_Line := succ(Screen_Top - Lines_Avail);
if Active_Line < 1 then Active_Line := 1;
if not Find_Line(Active_Line) then
begin
ShowError(710,'Pressed_PgUp');
exit;
end;
if Active_Line < Screen_Top then Show_Lines(Active_Line,Total_Lines);
CursorLine := 1;
if length(Work_Line^.Valu_Line)+1 < CursorPos then
CursorPos := length(Work_Line^.Valu_Line)+1;
end;

procedure GS_Edit_Objt.Pressed_UpAr;
begin {Up Arrow}
if Active_Line <= 1 then exit;
if not Find_Line(pred(Active_Line)) then
begin
ShowError(710,'Pressed_UpAr');
exit;
end;
if Active_Line < Screen_Top then
begin
gotoxy(1,1);
InsLine;
dec(Screen_Top);
write(Work_Line^.Valu_Line);
end;
if length(Work_Line^.Valu_Line)+1 < CursorPos then
CursorPos := length(Work_Line^.Valu_Line)+1;
end;

procedure GS_Edit_Objt.Pressed_DnAr;
begin {Down Arrow}
if Active_Line >= Total_Lines then exit;
if not Find_Line(succ(Active_Line)) then
begin
ShowError(710,'Pressed_DnAr');
exit;
end;
if Active_Line-Screen_Top >= Lines_Avail then
begin
GoToXY(1,1);
DelLine;
inc(Screen_Top);
GotoXY(1,Lines_Avail);
write(Work_Line^.Valu_Line);
end;
if length(Work_Line^.Valu_Line)+1 < CursorPos then
CursorPos := length(Work_Line^.Valu_Line)+1;
end;


procedure GS_Edit_Objt.Pressed_Ret;
begin {Return}
GS_KeyI_Ret := true;
Work_Line^.Return_Cod := $0D;
if GS_KeyI_Ins then
begin
ClrEol;
Temp_Line := Work_Line^.Valu_Line;
Work_Line^.Valu_Line := substr(Work_Line^.Valu_Line,1,pred(CursorPos));
delete(Temp_Line,1,pred(CursorPos));
Work_Line := Get_Line_Mem(Edit_Lgth);
Work_Line^.Valu_Line := Temp_Line;
if Active_Line-Screen_Top >= Lines_Avail then
begin
GoToXY(1,1);
DelLine;
inc(Screen_Top);
GotoXY(1,Lines_Avail);
write(Work_Line^.Valu_Line);
end else
begin
GotoXY(1,succ(CursorLine));
InsLine;
write(Work_Line^.Valu_Line);
end;
end
else
begin
if Active_Line-Screen_Top >= Lines_Avail then
begin
GoToXY(1,1);
DelLine;
inc(Screen_Top);
end;
if not Find_Line(succ(Active_Line)) then
Work_Line := Get_Line_Mem(Edit_Lgth);
GotoXY(1,CursorLine);
write(Work_Line^.Valu_Line);
end;
CursorPos := 1;
end;

procedure GS_Edit_Objt.Pressed_CrtlY;
var
p : GS_Edit_Pntr;
begin
if Total_Lines <= 1 then
begin
if not Find_Line(1) then
begin
SoundBell(BeepTime,BeepFreq);
ShowError(750,'Lost track of edit line');
exit;
end;
Work_Line^.Valu_Line := '';
DelLine;
exit;
end;
Rel_Line_Mem(Active_Line);
DelLine;
p := Work_Line;
CursorLine := succ(Active_Line-Screen_Top);
if length(Work_Line^.Valu_Line)+1 < CursorPos then
CursorPos := length(Work_Line^.Valu_Line)+1;
Show_Lines(Screen_Top,Total_Lines);
end;


procedure GS_Edit_Objt.Check_Func_Keys;
var
i : integer;
begin
case Ch_Work of
Kbd_F1 : Pressed_F1;
Kbd_Home : CursorPos := 1;
Kbd_End : CursorPos := Succ(Length(Work_Line^.Valu_Line));
Kbd_Ins : begin
GS_KeyI_Ins := not GS_KeyI_Ins;
GS_Scrn_SetCursor(GS_KeyI_Ins);
end;
Kbd_LfAr : if CursorPos > 1 then Dec(CursorPos);
Kbd_RtAr : if CursorPos <= Length(Work_Line^.Valu_Line) then Inc(CursorPos);
Kbd_Bsp : Pressed_Bsp;
Kbd_Del : Pressed_Del;
Kbd_PgUp : Pressed_PgUp;
Kbd_PgDn : Pressed_PgDn;
Kbd_UpAr : Pressed_UpAr;
Kbd_DnAr : Pressed_DnAr;
Kbd_Ret : Pressed_Ret;
Kbd_Esc : GS_KeyI_Esc := True;
#25 : Pressed_CrtlY; {CTRL-Y}

end;
end;

{
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ******** Edit String Procedure ******* ³
³ ³
³ This is the main method to edit an input string. The ³
³ usual cursor keys are processed through a method that ³
³ may be replaced by a child object's virtual method. ³
³ The Escape key will terminate and return the default ³
³ value to the calling program. ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
}


Procedure GS_Edit_Objt.Edit_Line;
var
t1 : string;
lc,
xl,
yl,
i : integer;
begin
if Work_Line = nil then
Work_Line := Get_Line_Mem(Edit_Lgth);
Insert(Ch_Work, Work_Line^.Valu_Line, CursorPos);
Inc(CursorPos); {Step to the next location in the string}
if not GS_KeyI_Ins then delete(Work_Line^.Valu_Line, CursorPos, 1);
GoToXY(1, CursorLine);
Write(Work_Line^.Valu_Line);

if length(Work_Line^.Valu_Line) >= Edit_Lgth then
WordWrap(Work_Line^.Valu_Line);
end; { Edit_Line }

procedure GS_Edit_Objt.Edit;
var
stx : string;
begin
StatWin.SetWin;
write(' F1 for Help CTRL-END to Quit ESC to Abort');
EditWin.SetWin;
WW_Flag := false;
Screen_Top := 0;
Screen_Btm := 0;
Ch_Work := #0;
CursorPos := 1;
CursorLine := 1;
Temp_Line := '';
GS_KeyI_Ins := True; {Start in insert mode}
GS_KeyI_Esc := False; {Set the Escape flag false}
GS_KeyI_Ret := false; {Set Return flag false}
Cursor_LocX := WhereX;
Cursor_LocY := WhereY;
Lines_Avail := hi(WindMax) - hi(WindMin);
inc(Lines_Avail); {Adjust for correct number}
GS_Scrn_SetCursor(GS_KeyI_Ins); {Go set cursor size}
if First_Line = nil then
Work_Line := Get_Line_Mem(Edit_Lgth)
else
begin
Work_Line := First_Line;
Active_Line := 1;
end;
Show_Lines(1,Lines_Avail);
repeat
window(1,24,80,24);
gotoxy(55,1);
write('Col: ',CursorPos:2,' Line: ',Active_Line,'':4);
window(EditWin.X1,EditWin.Y1,EditWin.X2,EditWin.Y2);
CursorLine := succ(Active_Line-Screen_Top);
GotoXY(CursorPos, CursorLine); {Go to current position in the screen}
{write updated part of line}
Ch_Work := GS_KeyI_GetKey; {Get the next keyboard entry}
if (GS_KeyI_Fuc) or (Ch_Work in [#0..#31]) then
{See if function key or control char}
Check_Func_Keys {If it is, go process it.}
else {Otherwise add character to the string}
Edit_Line; {Go add character to the line}
until ((GS_KeyI_Chr = Kbd_CEnd) and
(GS_KeyI_Fuc)) or (GS_KeyI_Esc);
{Continue until Ctrl-End or Esc pressed}
GS_Scrn_SetCursor(False); {Set cursor size to small cursor}
GS_KeyI_Ins := False;
EditWin.RelWin;
StatWin.RelWin;
end;


procedure GS_Edit_Objt.View;
var
stx : string;
begin
StatWin.SetWin;
write('ESC When Done':45);
EditWin.SetWin;
WW_Flag := false;
Screen_Top := 0;
Screen_Btm := 0;
Ch_Work := #0;
CursorPos := 1;
CursorLine := 1;
Temp_Line := '';
GS_KeyI_Ins := True; {Start in insert mode}
GS_KeyI_Esc := False; {Set the Escape flag false}
GS_KeyI_Ret := false; {Set Return flag false}
Cursor_LocX := WhereX;
Cursor_LocY := WhereY;
Lines_Avail := hi(WindMax) - hi(WindMin);
inc(Lines_Avail); {Adjust for correct number}
if First_Line = nil then
Work_Line := Get_Line_Mem(Edit_Lgth)
else
begin
Work_Line := First_Line;
Active_Line := 1;
end;
Show_Lines(1,Lines_Avail);
repeat
Ch_Work := GS_KeyI_GetKey; {Get the next keyboard entry}
if (GS_KeyI_Fuc) or (Ch_Work in [#0..#31]) then
case Ch_Work of
Kbd_PgUp : Pressed_PgUp;
Kbd_PgDn : Pressed_PgDn;
end;
until (Ch_Work = Kbd_Esc);
{Continue until Ctrl-End or Esc pressed}
GS_KeyI_Ins := False;
EditWin.RelWin;
StatWin.RelWin;
end;

function GS_Edit_Objt.Find_Line(linenum : integer) : boolean;
var
i : integer;
begin
if linenum > Total_Lines then
begin
Find_Line := false;
exit;
end;
if First_Line = nil then Work_Line := nil
else
begin
Work_Line := First_Line;
i := 1;
while (i < linenum) and (Work_Line <> nil) do
begin
Work_Line := Work_Line^.Next_Line;
inc(i);
end;
end;
if Work_Line = nil then
begin
Find_line := false;
ShowError(710,'Find_Line');
end
else
begin
Find_Line := true;
Active_Line := linenum;
end;
end;


function GS_Edit_Objt.Get_Line_Mem(lth : integer) : pointer;
var
i : longint;
p : GS_Edit_Pntr;
begin
GetMem(Work_Line,lth+15);
if First_Line = nil then
begin
First_Line := Work_Line;
End_Line := Work_Line;
Work_Line^.Next_Line := nil;
Work_Line^.Prev_Line := nil;
Active_Line := 1;
end else
begin
p := First_Line;
i := 1;
while (i < Active_Line) and (p^.Next_Line <> nil) do
begin
p := p^.Next_Line;
inc(i);
end;
Work_Line^.Next_Line := p^.Next_Line;
p^.Next_Line := Work_Line;
Work_Line^.Prev_Line := p;
Work_Line^.Next_Line^.Prev_Line := Work_Line;
inc(Active_Line);
end;
Work_Line^.Return_Cod := $0D;
Work_Line^.Line_Size := lth+15;
Work_Line^.Valu_Line := '';
inc(Total_Lines);
Get_Line_Mem := Work_Line;
end;

Procedure GS_Edit_Objt.Rel_Line_Mem(linenum : integer);
var
wl : GS_Edit_Pntr;
begin
if First_Line = nil then exit;
if not Find_Line(linenum) then exit;
if Work_Line = First_Line then
begin
First_Line := Work_Line^.Next_Line;
if First_Line <> nil then First_Line^.Prev_Line := nil;
end
else
begin
wl := Work_Line^.Prev_Line;
Work_Line^.Prev_Line^.Next_Line := Work_Line^.Next_Line;
if Work_Line^.Next_Line <> nil then
Work_Line^.Next_Line^.Prev_Line := Work_Line^.Prev_Line;
end;
FreeMem(Work_Line,Work_Line^.Line_Size);
dec(Total_Lines);
if Total_Lines < Active_Line then Active_Line := Total_Lines;
if not Find_line(Active_Line) then ShowError(710,'Rel_Line_Mem');
end;

Procedure GS_Edit_Objt.Show_Lines(b, e : integer);
var
i,
j : integer;
p : pointer;
a : longint;
begin;
if First_Line = nil then exit;
p := Work_Line;
a := Active_Line;
if b > Total_Lines then b := Total_Lines;
if e > Total_Lines then e := Total_Lines;
if e >= b + Lines_Avail then e := pred(b+Lines_Avail);
if not Find_Line(b) then
begin
ShowError(710,'Show_Lines');
Work_Line := p;
Active_Line := a;
exit;
end;
Screen_Top := b;
j := 1;
ClrScr;
for i := b to e do
begin
gotoxy(1,j);
inc(j);
write(Work_Line^.Valu_Line);
ClrEol;
Work_Line := Work_Line^.Next_Line;
end;
Work_Line := p;
Active_Line := a;
end;


Procedure GS_Edit_Objt.WordWrap(Fline : string);
var
lCnt : integer; {Counter for line length in characters}
linterm : byte; {Holds line termination code}
linchr : boolean;
wrapped : boolean;
A_L : longint;
wLine : string;


function WrapLine : boolean;
BEGIN { WordWrap }
if (length(wline) <= Edit_Lgth) then
begin
WrapLine := false;
exit;
end;
WrapLine := true;
lCnt := Edit_Lgth+1;
linchr := false;
while (not linchr) and (lcnt > 0) do
begin
case wline[lCnt] of
' ' : linchr := true;
'-' : linchr := true;
else dec(lCnt);
end;
{Repeat search for space or hyphen until}
{found or current line exhausted}
end;
if (lCnt = 0) then lcnt := Edit_Lgth;
{If no break point, truncate line}
Temp_Line := wline;
delete(Temp_Line,1,lCnt);
wline[0] := chr(lcnt);
{Get string up to cursor to split line}
if (CursorPos < length(wline)) and
((Temp_Line = ' ') or (Temp_Line = '')) then
begin
WrapLine := false;
exit;
end;
end;

BEGIN
wrapped := false;
wline := Fline;
A_L := Active_Line;
while WrapLine do
begin
wrapped := true;
Work_Line^.Valu_Line := wline;
linterm := Work_Line^.Return_Cod;
Work_Line^.Return_Cod := $8D; {Insert soft return character}
if linterm = $0D then
begin
Work_Line := Get_Line_Mem(Edit_Lgth);
Work_Line^.Return_Cod := linterm;
end
else
begin
if not Find_Line(succ(Active_Line)) then
begin
Work_Line := Get_Line_Mem(Edit_Lgth);
Work_Line^.Return_Cod := linterm;
end;
end;
wline := Temp_Line + Work_Line^.Valu_Line;
end;
Work_Line^.Valu_Line := wline;
if not wrapped then exit;
if not Find_Line(A_L) then
begin
ShowError(710,'WordWrap');
end;
if (CursorPos > length(Work_Line^.Valu_Line)) and
(CursorPos <> Edit_Lgth+1) then
begin
CursorPos := CursorPos - length(Work_Line^.Valu_Line);
if not Find_Line(succ(Active_Line)) then
begin
ShowError(710,'WordWrap 2');
end;
end;
if ((succ(Active_Line)) - Screen_Top) > Lines_Avail then
begin
Screen_Top := (succ(Active_Line)) - Lines_Avail;
end;
Show_Lines(Screen_Top, (Screen_Top-1) + Lines_Avail);
CursorLine := (succ(Active_Line)) - Screen_Top;
end; {WordWrap}

end.

{ Save for testing }

Procedure GS_Edit_Objt.PrintMem;
var
i,
j : integer;
p : pointer;
begin;
Work_Line := First_Line;
while Work_Line <> nil do
begin
with Work_Line^ do
begin
writeln(lst,Return_Cod:4,' ',Valu_Line);
end;
Work_Line := Work_Line^.Next_Line;
end;
end;

end.