Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/RADOOR30.ZIP/BBSEDIT.ZIP/BBSEDIT.PAS

Pascal/Delphi Source File | 1994-04-12 | 6.9 KB | 269 lines

{╔═════════════════════════════════════════════════════════════════════════╗
 ║                                                                         ║
 ║                   (c) CopyRight LiveSystems 1990, 1994                  ║
 ║                                                                         ║
 ║ Author    : Gerhard Hoogterp                                            ║
 ║ FidoNet   : 2:282/100.5   2:283/7.33                                    ║
 ║ BitNet    : [e-mail]                                     ║
 ║                                                                         ║
 ║ SnailMail : Kremersmaten 108                                            ║
 ║             7511 LC Enschede                                            ║
 ║             The Netherlands                                             ║
 ║                                                                         ║
 ║        This module is part of the RADoor BBS doorwriters toolbox.       ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝}
Unit BBSedit;
Interface
Uses KeyDefs,
     LowLevel,
     UserHook,
     Fossil,
     GlobInfo,
     RA;


{
  MenuKeys: Position  Meaning
               1      Abort         Make sure the keys are in this order!!
               2      List
               3      Continue
               4      Save
}

Const StatLine    : String[100] = '';
      MenuLine    : String[100] = '';
      MenuKeys    : String[6]   = '';
      YourChoice  : String[20]  = '';
      Counter     : String[20]  = '';

Type  LineType  = String[80];
      BodyArray = Array[0..255] Of LineType;
      BodyType  = ^BodyArray;

Procedure LineEditor(Var Foss     : FossilObject;
                         Body     : BodyType;
                     Var Lines    : Byte;
                         MaxLines : Byte);


Implementation


Procedure LineEditor(Var Foss     : FossilObject;
                         Body     : BodyType;
                     Var Lines    : Byte;
                         MaxLines : Byte);

Var StopEdit : Boolean;
    CurrLine : Byte;
    Key      : Char;

Procedure List(Start : Byte;More : Boolean);
Var Count  : Byte;
    TCount : String[20];
    CPos   : Byte;

Begin
With Foss Do
 Begin
 ClrScrF;
 WriteLnF(StatLine);
 WriteLnF('');

 If CurrLine=0
    Then Exit;

 For Count := Start To CurrLine-1 Do
  Begin
  TCount:=Counter;
  CPos:=Pos('@',TCount);
  Delete(TCount,CPos,1);
  Insert(S(Count,3),TCount,CPos);
  WriteLnF(TCount+Body^[Count]);
  If More And ((Count Mod (GlobalInfo.ScreenLength-4))=(GlobalInfo.ScreenLength-5))
     Then Begin
          WriteLnF('');
          PressENTER;
          ClrScrF;
          WriteLnF(StatLine);
          WriteLnF('');
          End;
  End; {For}
 End; {With}
End;



Function WrapLine(Var Line : LineType):LineType;
Var LinePtr : Byte;
    DelChars: Byte;
Begin
LinePtr:=Length(Line);
While (LinePtr>0) And (Not (Line[LinePtr] In [' ',#9])) Do
 Dec(LinePtr);
If LinePtr=0
   Then Begin
        WrapLine:='';
        Exit;
        End;

For DelChars:=1 To (Length(Line)-LinePtr+1) Do
  Foss.WriteF(#8' '#8);
WrapLine:=Copy(Line,LinePtr+1,Length(Line)-LinePtr);
Line:=Copy(Line,1,LinePtr-1);
End;



Procedure EditText;

Var TempLine : String[80];
    Gotcha   : Boolean;
    Key      : Char;
    Stop     : Boolean;
    TCount   : String[20];
    CPos     : Byte;


Begin
With Foss Do
 Begin
 Stop:=False;
 TCount:=Counter;
 CPos:=Pos('@',TCount);
 Delete(TCount,CPos,1);
 Insert(S(CurrLine,3),TCount,CPos);
 WriteF(#13+TCount);

 Repeat
  Gotcha:=False;
  Repeat
  If KeyPressedF
     Then Begin
          Key:=ReadKeyF;
          If Key<>#$FF         { The SysOp Keys! }
             Then Gotcha:=True;
          End;
  Until Gotcha Or Emergency;

 Case Key Of
  CR  : Begin
        If (Body^[CurrLine]<>'') And
           (CurrLine<MaxLines)
           Then Begin
                Inc(CurrLine);
                WriteF(#13#10);
                TCount:=Counter;
                CPos:=Pos('@',TCount);
                Delete(TCount,CPos,1);
                Insert(S(CurrLine,3),TCount,CPos);
                WriteF(TCount);
                End
           Else Stop:=True;
        End;
  BS  : Begin
        If Body^[CurrLine]<>''
           Then Begin
                Dec(Body^[CurrLine][0]);
                WriteF(#8' '#8);
                End;
        End;
  Else  Begin
        If Key>=#32
           Then Begin
                WriteF(Key);
                Body^[CurrLine]:=Body^[CurrLine]+Key;
                If Length(Body^[CurrLine])=65
                   Then Begin
                        Inc(CurrLine);
                        If CurrLine<MaxLines
                           Then Begin
                                Body^[CurrLine]:=WrapLine(Body^[CurrLine-1]);
                                WriteF(#13#10);
                                TCount:=Counter;
                                CPos:=Pos('@',TCount);
                                Delete(TCount,CPos,1);
                                Insert(S(CurrLine,3),TCount,CPos);
                                WriteF(TCount);
                                WriteF(Body^[CurrLine]);
                                End
                           Else Begin
                                WriteF(#7);
                                Stop:=True;
                                End;
                        End;
                End;
        End;
 End; {Case}
 Until Emergency Or Stop;
 End; {With FOSS}
End;


Begin
CurrLine:=Lines;
StopEdit:=False;
With Foss Do
 Begin
 If CurrLine>0
    Then Begin
         If CurrLine>10
             Then List(CurrLine-10,False)
             Else List(0,False);
        End
    Else Begin
         ClrScrF;
         WriteLnF(StatLine);
         WriteLnF('');
         End;
 End;



EditText;

Repeat  { Do menu }
 With Foss Do
  Begin
  WriteF(#13);
  WriteLnF('^1'+MakeString(79,'─')+'^0');
  WriteLnF(MenuLine);
  WriteF(YourChoice);
  Key:=Upcase(Foss.AskKey(MenuKeys,MenuKeys[1]));
  End; {With}

  Case Pos(Key,MenuKeys) Of
    1  : Begin
         StopEdit:=True;
         Body^[0]:='';
         Lines:=0;
         End;
    2  : List(0,True);
    3  : Begin
         If CurrLine>10
            Then List(CurrLine-10,False)
            Else List(0,False);
         EditText;
         End;
    4  : Begin
         StopEdit:=True;
         If CurrLine>0
            Then Lines:=CurrLine-1;
         End;
  End; {Case}

Until StopEdit Or Foss.Emergency;
End;

Begin

{ Default strings for the editor. }

StatLine:=Center('-=( Type your text now, use an empty line to finish )=-');
MenuLine   := '   [L]ist      [C]ontinue      [S]ave       [A]bort';
YourChoice := '   Your choice: ';
MenuKeys   := 'ALCS';
Counter    := '@]';
End.