home *** CD-ROM | disk | FTP | other *** search
- 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.