*/
Know a good article or link that we're missing? Submit it!
*/

View \GSOB_EDT.PAS

Halcyon version 3.0

Submitted By: Unknown
Rating: (Not rated) (Rate It)


{-----------------------------------------------------------------------------
                                 Editor Routines

       GSOB_Edt Copyright (c)  Richard F. Griffin

       08 May 1993

       102 Molded Stone Pl
       Warner Robins, GA  31088

       -------------------------------------------------------------
       This unit handles the objects for a simple editor.

                 --- DOES NOT COMPILE UNDER WINDOWS ---

       Changes:

------------------------------------------------------------------------------}


Unit GSOB_Edt;

interface

uses
   GSOB_Obj,
   GSOB_Str,
   CRT,
   DOS;

type

   TEvent = record
      What: Integer;
      case Integer of
            0: (KeyCode: Word);
            1: (CharCode: Char;
                ScanCode: Byte);
   end;

   TPoint = Record
      X : Integer;
      Y : Integer;
   end;


   GSP_ShowView = ^GSO_ShowView;
   GSO_ShowView = object(TObject)
      edLineColl  : GSP_LineCollection;
      LineRet     : byte;
      Work_Line   : string;
      LineOnly    : boolean;
      Cursor,
      Delta,
      Size,
      Limit,
      PhyPos      : TPoint;
      constructor Init(P : GSP_LineCollection);
      procedure   Draw; virtual;
      procedure   FindLine(linenum : integer);
      procedure   FixView;
      procedure   HandleEvent(var Event : TEvent); virtual;
      function    WorkView : boolean;
   end;

   GSP_EditView = ^GSO_EditView;
   GSO_EditView = object(GSO_ShowView)
      Edit_Lgth   : integer;          {Max size of each line}
      InsertOn    : boolean;
      Modified    : boolean;
      constructor Init(P : GSP_LineCollection; L : Integer);
      Procedure   Draw; virtual;
      Procedure   EditLine(Ch_Work : char);
      procedure   GetNewLine;
      procedure   HandleEvent(var Event : TEvent); virtual;
      Procedure   Pressed_Bsp;
      Procedure   Pressed_CrtlY;
      Procedure   Pressed_Del;
      Procedure   Pressed_Ret;
      procedure   PutLine;
      procedure   ReleaseLine;
      Procedure   WordWrap;
   end;

implementation

const

   InsStatOn  = '[Ins]';
   InsStatOff = '[OvL]';
   EmptyLine  : String[1] = '';
   TabSpaces  = 8;


{ Extended key codes }

   kbEsc       = $011B;
   kbBack      = $0E08;
   kbShiftTab  = $0F00;
   kbTab       = $0F09;
   kbEnter     = $1C0D;
   kbF1        = $3B00;
   kbF10       = $4400;
   kbHome      = $4700;
   kbUp        = $4800;
   kbPgUp      = $4900;
   kbLeft      = $4B00;
   kbRight     = $4D00;
   kbEnd       = $4F00;
   kbDown      = $5000;
   kbPgDn      = $5100;
   kbIns       = $5200;
   kbDel       = $5300;
   kbCtrlEnd   = $7500;
   kbCtrlPgDn  = $7600;
   kbCtrlHome  = $7700;
   kbCtrlPgUp  = $8400;

var
   Tmp_Line : string;
   Ch_Work  : char;

   GS_KeyE_Scn   : byte;
   GS_KeyE_Esc,
   GS_KeyE_Fuc   : boolean;
   GS_KeyE_Chr,
   GS_KeyE_Cde   : char;


{ GS_KeyE_GetKey reads and returns a character from the keyboard.  If the
  character is a function key, GS_KeyE_Func is set true.  The character is
  also saved in unit local variable GS_KeyE_Chr.  The scan code is saved in
  unit local variable GS_KeyE_ScanCode. }


function GS_KeyE_GetKey : char;
var
   reg : Registers;
begin
  reg.AX := 0;
  Intr($16,reg);
  GS_KeyE_Cde := char(reg.AL);
  GS_KeyE_Scn := reg.AH;
  if GS_KeyE_Cde = #0 then
    begin
      GS_KeyE_Fuc := true;
      GS_KeyE_Chr := char(GS_KeyE_Scn);
    end
  else
  begin
    GS_KeyE_Fuc := false;
    GS_KeyE_Chr := GS_KeyE_Cde;
  end;
  GS_KeyE_GetKey := GS_KeyE_Chr;
end; {GS_KeyE_GetKey}



{------------------------------------------------------------------------------
                                GSO_ShowView
------------------------------------------------------------------------------}


constructor GSO_ShowView.Init(P : GSP_LineCollection);
var
   i : integer;
begin
   Cursor.X := 0;
   Cursor.Y := 0;
   Size.X := Lo(WindMax)-Lo(WindMin)+1;
   Size.Y := Hi(WindMax)-Hi(WindMin)-1;
   Delta.X := 0;
   Delta.Y := 0;
   Limit.X := Size.X;
   Limit.Y := P^.Count;
   PhyPos.X := 0;
   PhyPos.Y := 0;
   Work_Line := '';
   edLineColl := P;
   LineOnly := false;
   GoToXY(1,Size.Y+1);
   for i := 1 to Size.X do write(#205);
   GoToXY(1,Size.Y+2);
   write(' F10 to Quit    ESC to Abort');
   if edLineColl^.Count = 0 then exit;
   FindLine(0);
   Draw;
end;

procedure GSO_ShowView.Draw;
var
   Y     : Integer;
   i     : integer;
   s     : String;
   z     : boolean;
begin
   FixView;
   for Y := 0 to Size.Y-1 do
   begin
      z := false;
      i := (Y+Delta.Y);
      if i > Limit.Y then z := true;
      if (LineOnly) then
          if Y = Cursor.Y then
             s := Work_Line else z := true
      else
      if (i < edLineColl^.Count) then
            s := GSP_LineBuf(edLineColl^.Items^[i])^.LineText
         else
            s := EmptyLine;
      if not z then
      begin
         FillChar(Tmp_Line[1],Size.X,' ');
         Tmp_Line := s;
         Tmp_Line[0] := char(Size.X);
         GoToXY(1,Y+1);
         Write(Tmp_Line);
      end
      else if (i > Limit.Y) and not LineOnly then
      begin
         GoToXY(1,Y+1);
         ClrEol;
      end;
   end;
   LineOnly := false;
   gotoxy(65,Size.Y+2);
   write('Line: ',PhyPos.Y+1,'':4);
   GoToXY(1,Cursor.Y+1);
end;

procedure GSO_ShowView.FindLine(linenum : integer);
var
   p : GSP_LineBuf;
begin
   if linenum < 0 then linenum := 0;
   if linenum >= edLineColl^.Count then linenum := edLineColl^.Count-1;
   p := edLineColl^.At(linenum);
   Work_Line := p^.LineText;
   LineRet := p^.LineRetn;
   PhyPos.Y := linenum;
end;

procedure GSO_ShowView.FixView;
var
   D : TPoint;
begin
   D := Delta;
   if Cursor.Y > Size.Y-1 then
   begin
      Delta.Y := Delta.Y + (Cursor.Y-(Size.Y-1));
      Cursor.Y := Size.Y-1;
   end
   else
   begin
      if Cursor.Y < 0 then
      begin
         Delta.Y := Delta.Y+Cursor.Y;
         Cursor.Y := 0;
      end;
   end;
   if Delta.Y >= Limit.Y then Delta.Y := Limit.Y-1;
   if Delta.Y < 0 then Delta.Y := 0;
   if Cursor.X >= Size.X then Cursor.X := Size.X-1
   else
      if Cursor.X < 0 then Cursor.X := 0;
   FindLine(Delta.Y+Cursor.Y);
   Cursor.Y := (PhyPos.Y - Delta.Y);
   if Cursor.Y < 0 then Cursor.Y := 0;
   if Cursor.Y >= (Limit.Y) then Cursor.Y := Limit.Y-1;
   PhyPos.X := Cursor.X;
   LineOnly := LineOnly and (D.Y = Delta.Y);
end;

procedure GSO_ShowView.HandleEvent(var Event : TEvent);
var
   cw    : char;
   D,
   Mouse : TPoint;
begin
   D := Delta;
   case Event.KeyCode of
      kbCtrlPgUp : Delta.Y := 0;
      kbCtrlPgDn : Delta.Y := Limit.Y;
      kbCtrlHome : Cursor.Y := 0;
      kbCtrlEnd  : Cursor.Y := Size.Y-1;
      kbPgUp     : Delta.Y := Delta.Y-(Size.Y)-1;
      kbPgDn     : Delta.Y := Delta.Y+(Size.Y)-1;
      kbHome     : Cursor.X := 0;
      kbEnd      : Cursor.X := Length(Work_Line);
      kbLeft     : if Cursor.X > 0 then Dec(Cursor.X);
      kbRight    : if Cursor.X < Length(Work_Line) then Inc(Cursor.X);
      kbUp       : dec(Cursor.Y);
      kbDown     : inc(Cursor.Y);
      kbEsc,
      kbF10      : begin end;
      else exit;
   end;
   LineOnly := D.Y = Delta.Y;
   if edLineColl^.Count > 0 then Draw;
   Event.KeyCode := 0;
END;

Function GSO_ShowView.WorkView : boolean;
var
   Event : TEvent;
   kch   : char;
   kcd   : word;
begin
   repeat
      kch := GS_KeyE_GetKey;  {Get the next keyboard entry}
      Event.CharCode := GS_KeyE_Cde;
      Event.ScanCode := GS_KeyE_Scn;
      kcd := Event.KeyCode;
      HandleEvent(Event);
   until (kcd = kbF10) or (kcd = kbEsc);
   WorkView := kcd <> kbEsc;
end;

{------------------------------------------------------------------------------
                                GSO_EditView
------------------------------------------------------------------------------}


constructor GSO_EditView.Init(P : GSP_LineCollection; L : Integer);
begin
   GSO_ShowView.Init(P);
   Modified := false;
   Edit_Lgth := L;
   InsertOn := True;               {Start in insert mode}
   if L > Size.X then Edit_Lgth := Size.X;
   if edLineColl^.Count = 0 then GetNewLine;
end;

Procedure GSO_EditView.Draw;
begin
   PutLine;
   GSO_ShowView.Draw;
   gotoxy(48,Size.Y+2);
   if InsertOn then write(InsStatOn) else write(InsStatOff);
   gotoxy(55,Size.Y+2);
   write('Col: ',Cursor.X+1:2);
   if Cursor.X > length(Work_Line) then Cursor.X := length(Work_Line);
   GotoXY(Cursor.X+1,Cursor.Y+1){Go to current position in the screen}
end;

Procedure GSO_EditView.EditLine(Ch_Work : char);
begin
   Modified := true;
   if InsertOn then System.Insert(Ch_Work, Work_Line, PhyPos.X+1)
      else Work_Line[PhyPos.X+1] := Ch_Work;
   Inc(PhyPos.X);                {Step to the next location in the string}
   if length(Work_Line) >= Edit_Lgth then WordWrap
      else LineOnly := true;
end; { EditLine }

procedure GSO_EditView.GetNewLine;
begin
   Work_Line := '';
   LineRet := $0D;
   edLineColl^.InsertItemAt($8D,Work_Line,PhyPos.Y);
   Limit.Y := edLineColl^.Count;
end;

procedure GSO_EditView.HandleEvent(var Event : TEvent);
begin
   GSO_ShowView.HandleEvent(Event);
   case Event.KeyCode of
      0         : Exit;
      kbBack    : Pressed_Bsp;
      kbDel     : Pressed_Del;
      kbEnter   : Pressed_Ret;
      kbIns     : InsertOn := not InsertOn;
      else
         case Event.CharCode of
         #25       : Pressed_CrtlY;
         #32..#255  : EditLine(Event.CharCode);
         else exit;
      end;
   end;
   Cursor.Y := PhyPos.Y-Delta.Y;
   Cursor.X := PhyPos.X;
   Draw;
END;

procedure GSO_EditView.Pressed_Bsp;
var
   bb : byte;
begin
   Modified := true;
   if PhyPos.X > 0 then
   begin
      System.Delete(Work_Line, PhyPos.X, 1);
      Dec(PhyPos.X);
   end
   else
   begin
      if PhyPos.Y > 0 then
      begin
         bb := LineRet;
         Tmp_Line := Work_Line;
         ReleaseLine;
         if PhyPos.Y < (Limit.Y-1) then FindLine(PhyPos.Y-1);
         PhyPos.X := length(Work_Line);
         Work_Line := Work_Line + Tmp_Line;
         LineRet := bb;
         WordWrap;
         LineOnly := false;
      end;
   end;
end;

procedure GSO_EditView.Pressed_Del;
begin
   Modified := true;
   if PhyPos.X < Length(Work_Line)-1 then
      System.Delete(Work_Line, PhyPos.X+1, 1)
   else
   begin
      if PhyPos.Y < edLineColl^.Count-1 then
      begin
         PutLine;
         FindLine(PhyPos.Y+1);
         PhyPos.X := 0;
         Pressed_Bsp;
      end;
   end;
end;

procedure GSO_EditView.Pressed_Ret;
begin         {Return}
   Modified := true;
   if InsertOn then
   begin
      Tmp_Line := copy(Work_Line,1,PhyPos.X);
      System.delete(Work_Line,1,PhyPos.X);
      PutLine;
      GetNewLine;
      LineRet := $0D;
      Work_Line := Tmp_Line;
   end;
   PutLine;
   FindLine(PhyPos.Y+1);
   PhyPos.X := 0;
end;

procedure GSO_EditView.Pressed_CrtlY;
begin
   Modified := true;
   if edLineColl^.Count = 1 then
      Work_Line := ''
   else
      ReleaseLine;
end;

Procedure GSO_EditView.PutLine;
begin
   if edLineColl^.Count = 0 then exit;
   edLineColl^.Free(edLineColl^.At(PhyPos.Y));
   edLineColl^.InsertItemAt(LineRet,Work_Line,PhyPos.Y);
end;

Procedure GSO_EditView.ReleaseLine;
begin
   if PhyPos.Y = 0 then exit;
   edLineColl^.Free(edLineColl^.At(PhyPos.Y));
   if PhyPos.Y >= edLineColl^.Count then
      PhyPos.Y := edLineColl^.Count-1;
   FindLine(PhyPos.Y);
   Limit.Y := edLineColl^.Count;
end;

Procedure GSO_EditView.WordWrap;
var
   lCnt : integer;                    {Counter for line length in characters}
   linterm : byte;                    {Holds line termination code}
   linchr : boolean;
   wrapped : boolean;
   A_L    : longint;


   function WrapLine : boolean;
   BEGIN                       { WordWrap }
      if (length(Work_Line) < Edit_Lgth) then
      begin
         WrapLine := false;
         exit;
      end;
      lCnt := Edit_Lgth;
      linchr := false;
      if Work_Line[lcnt] <> ' ' then
      begin
         dec(lcnt);
         while (not linchr) and (lcnt > 0) do
            if Work_Line[lCnt] in [' ','-'] then linchr := true
               else dec(lCnt);
      end;
      if (lCnt = 0) then lcnt := Edit_Lgth;
                                      {If no break point, truncate line}
      Tmp_Line := Work_Line;
      Work_Line[0] := chr(lcnt);
      system.delete(Tmp_Line,1,lCnt);
      if PhyPos.X >= lcnt-1 then
      begin
         PhyPos.X := PhyPos.X-lcnt;
         inc(A_L);
      end;
      WrapLine := true;
   end;

BEGIN
   wrapped := false;
   A_L := PhyPos.Y;
   while WrapLine do
   begin
      wrapped := true;
      if LineRet = $0D then
      begin
         LineRet := $8D;
         PutLine;
         inc(PhyPos.Y);
         GetNewLine;
         LineRet := $0D;
      end
      else
      begin
         PutLine;
         inc(PhyPos.Y);
         if edLineColl^.Count > PhyPos.Y then FindLine(PhyPos.Y)
            else GetNewLine;
      end;
      Work_Line := Tmp_Line + Work_Line;
   end;
   if not wrapped then
      LineOnly := true
   else
   begin
      PutLine;
      FindLine(A_L);
   end;
end;                         {WordWrap}


end.
{------------------------------------------------------------------------------}

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.