eric
/
Renegade-1.19
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Renegade-1.19/SYSOP4.PAS

545 lines
14 KiB
Plaintext
Raw Normal View History

02-04
2013-02-04 15:56:58 -08:00
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S-,V-}
UNIT SysOp4;
INTERFACE
USES
Common;
PROCEDURE TEdit1;
PROCEDURE TEdit(CONST FSpec: AStr);
IMPLEMENTATION
USES
Dos;
PROCEDURE TEdit1;
VAR
FSpec: AStr;
Dir: DirStr;
Name: NameStr;
Ext: ExtStr;
BEGIN
NL;
Prt('File name: ');
IF (FileSysOp) THEN
BEGIN
MPL(50);
Input(FSpec,50);
END
ELSE
BEGIN
MPL(12);
Input(FSpec,12);
FSplit(FSpec,Dir,Name,Ext);
FSpec := Name+Ext;
END;
TEdit(FSpec);
END;
PROCEDURE TEdit(CONST FSpec: AStr);
TYPE
StrPtr = ^StrRec;
StrRec = RECORD
S: AStr;
Next,
Last: StrPtr;
END;
VAR
TopHeap: ^Byte;
Fil: Text;
Cur,
Nex,
Las,
Top,
Bottom,
Used: StrPtr;
S: AStr;
TotalLines,
CurLine,
I: Integer;
Done,
AllRead: Boolean;
PROCEDURE InLi(VAR S1: AStr);
VAR
C,
C1: Char;
Cp,
Rp,
CV,
CC: Integer;
PROCEDURE BKSpc;
BEGIN
IF (Cp > 1) THEN
BEGIN
IF (S1[Cp - 2] = '^') AND (S1[Cp - 1] IN ['0'..'9']) THEN
BEGIN
UserColor(1);
Dec(Cp);
END
ELSE IF (S1[Cp - 1] = #8) THEN
BEGIN
Prompt(' ');
Inc(Rp);
END
ELSE IF (S1[Cp - 1] <> #10) THEN
BEGIN
Prompt(#8+' '+#8);
Dec(Rp);
END;
Dec(Cp);
END;
END;
BEGIN
Rp := 1;
Cp := 1;
S1 := '';
IF (LastLineStr <> '') THEN
BEGIN
Prompt(LastLineStr);
S1 := LastLineStr;
LastLineStr := '';
Cp := (Length(S1) + 1);
Rp := Cp;
END;
REPEAT
C := Char(GetKey);
CASE C of
#32..#255 :
IF (Cp < StrLen) AND (Rp < ThisUser.LineLen) THEN
BEGIN
S1[Cp] := C;
Inc(Cp);
Inc(Rp);
OutKey(C);
END;
^H : BKSpc;
^S : BEGIN
CV := (5 - (Cp MOD 5));
IF ((Cp + CV) < StrLen) AND ((Rp + CV) < ThisUser.LineLen) THEN
FOR CC := 1 TO CV DO
BEGIN
Prompt(' ');
S1[Cp] := ' ';
Inc(Rp);
Inc(Cp);
END;
END;
^P : IF (OkANSI OR OkAvatar) AND (Cp < (StrLen - 1)) THEN
BEGIN
C1 := Char(GetKey);
IF (C1 IN ['0'..'9']) THEN
BEGIN
S1[Cp] := '^';
Inc(Cp);
S1[Cp] := C1;
Inc(Cp);
UserColor(Ord(S1[Cp - 1]));
END;
END;
^X : BEGIN
Cp := 1;
FOR CV := 1 TO (Rp - 1) DO
Prompt(#8+' '+#8);
UserColor(1);
Rp := 1;
END;
END;
UNTIL ((C = ^M) OR (Rp = ThisUser.LineLen) OR (HangUp));
S1[0] := Chr(Cp - 1);
IF (C <> ^M ) THEN
BEGIN
CV := (Cp - 1);
WHILE (CV > 1) AND (S1[CV] <> ' ') AND ((S1[CV] <> ^H) OR (S1[CV - 1] = '^')) DO
Dec(CV);
IF (CV > (Rp DIV 2)) AND (CV <> (Cp - 1)) THEN
BEGIN
LastLineStr := Copy(S1,(CV + 1),(Cp - CV));
FOR CC := (Cp - 2) DOWNTO CV DO
Prompt(^H);
FOR CC := (Cp - 2) DOWNTO CV DO
Prompt(' ');
S1[0] := Chr(CV - 1);
END;
END;
NL;
END;
FUNCTION NewPtr(VAR x: StrPtr): Boolean;
BEGIN
IF (Used <> NIL) THEN
BEGIN
x := Used;
Used := Used^.Next;
NewPtr := TRUE;
END
ELSE
BEGIN
IF (MaxAvail > 2048) THEN
BEGIN
New(x);
NewPtr := TRUE;
END
ELSE
NewPtr := FALSE;
END;
END;
PROCEDURE OldPtr(VAR x: StrPtr);
BEGIN
x^.Next := Used;
Used := x;
END;
PROCEDURE PLine(Cl: Integer; VAR Cp: StrPtr);
VAR
S1: AStr;
BEGIN
IF (NOT Abort) THEN
BEGIN
IF (Cp = NIL) THEN
S1 := ' ^5'+'[^3'+'END^5'+']'
ELSE
S1 := PadRightInt(Cl,4)+': '+Cp^.S;
PrintACR(S1);
END;
END;
PROCEDURE PL;
BEGIN
Abort := FALSE;
PLine(CurLine,Cur);
END;
BEGIN
Mark(TopHeap);
Used := NIL;
Top := NIL;
Bottom := NIL;
AllRead := TRUE;
IF (FSpec = '') THEN
BEGIN
Print('Aborted.');
END
ELSE
BEGIN
Abort := FALSE;
Next := FALSE;
TotalLines := 0;
New(Cur);
Cur^.Last := NIL;
Cur^.S := '';
NL;
Assign(Fil,FSpec);
Reset(Fil);
IF (IOResult <> 0) THEN
BEGIN
ReWrite(Fil);
IF (IOResult <> 0) THEN
BEGIN
Print('Error reading file.');
Abort := TRUE;
END
ELSE
BEGIN
Close(Fil);
Erase(Fil);
Print('New file.');
TotalLines := 0;
Cur := NIL;
Top := Cur;
Bottom := Cur;
END;
END
ELSE
BEGIN
Abort := NOT NewPtr(Nex);
Top := Nex;
Print('^1Loading...');
WHILE ((NOT EOF(Fil)) AND (NOT Abort)) DO
BEGIN
Inc(TotalLines);
Cur^.Next := Nex;
Nex^.Last := Cur;
Cur := Nex;
ReadLn(Fil,S);
Cur^.S := S;
Abort := NOT NewPtr(Nex);
END;
Close(Fil);
Cur^.Next := NIL;
IF (TotalLines = 0) THEN
BEGIN
Cur := NIL;
Top := NIL;
END;
Bottom := Cur;
IF (Abort) THEN
BEGIN
NL;
Print(^G^G'|12WARNING: |10Not all of file read.^3');
NL;
AllRead := FALSE;
END;
Abort := FALSE;
END;
IF (NOT Abort) THEN
BEGIN
Print('Total lines: '+IntToStr(TotalLines));
Cur := Top;
IF (Top <> NIL) THEN
Top^.Last := NIL;
CurLine := 1;
Done := FALSE;
PL;
REPEAT
Prt(':');
Input(S,10);
IF (S = '') THEN
S := '+';
IF (StrToInt(S) > 0) THEN
BEGIN
I := StrToInt(S);
IF ((I > 0) AND (I <= TotalLines)) THEN
BEGIN
WHILE (I <> CurLine) DO
IF (I < CurLine) THEN
BEGIN
IF (Cur = NIL) THEN
BEGIN
Cur := Bottom;
CurLine := TotalLines;
END
ELSE
BEGIN
Dec(CurLine);
Cur := Cur^.Last;
END;
END
ELSE
BEGIN
Inc(CurLine);
Cur := Cur^.Next;
END;
PL;
END;
END
ELSE
CASE S[1] of
'?' : BEGIN
LCmds(14,3,'+Forward line','-Back line');
LCmds(14,3,'Top','Bottom');
LCmds(14,3,'Print line','List');
LCmds(14,3,'Insert lines','Delete line');
LCmds(14,3,'Replace line','Clear all');
LCmds(14,3,'Quit (Abort)','Save');
LCmds(14,3,'*Center line','!Memory Available');
END;
'!' : Print('Heap space available: '+IntToStr(MemAvail));
'*' : IF (Cur <> NIL) THEN
Cur^.S := #2+Cur^.S;
'+' : IF (Cur <> NIL) THEN
BEGIN
I := StrToInt(Copy(S,2,9));
IF (I = 0) THEN
I := 1;
WHILE (Cur <> NIL) AND (I > 0) DO
BEGIN
Cur := Cur^.Next;
Inc(CurLine);
Dec(I);
END;
PL;
END;
'-' : BEGIN
I := StrToInt(Copy(S,2,9));
IF (I = 0) THEN
I := 1;
IF (Cur = NIL) THEN
BEGIN
Cur := Bottom;
CurLine := TotalLines;
Dec(I);
END;
IF (Cur <> NIL) THEN
IF (Cur^.Last <> NIL) THEN
BEGIN
WHILE ((Cur^.Last <> NIL) AND (I > 0)) DO
BEGIN
Cur := Cur^.Last;
Dec(CurLine);
Dec(I);
END;
PL;
END;
END;
'B' : BEGIN
Cur := NIL;
CurLine := (TotalLines + 1);
PL;
END;
'C' : IF PYNQ('Clear workspace? ',0,FALSE) THEN
BEGIN
TotalLines := 0;
CurLine := 1;
Cur := NIL;
Top := NIL;
Bottom := NIL;
Release(TopHeap);
END;
'D' : BEGIN
I := StrToInt(Copy(S,2,9));
IF (I = 0) THEN
I := 1;
WHILE (Cur <> NIL) AND (I > 0) DO
BEGIN
Las := Cur^.Last;
Nex := Cur^.Next;
IF (Las <> NIL) THEN
Las^.Next := Nex;
IF (Nex <> NIL) THEN
Nex^.Last := Las;
OldPtr(Cur);
IF (Bottom = Cur) THEN
Bottom := Las;
IF (Top = Cur) THEN
Top := Nex;
Cur := Nex;
Dec(TotalLines);
Dec(I);
END;
PL;
END;
'I' : BEGIN
Abort := FALSE;
Next := FALSE;
LastLineStr := '';
NL;
Print(' Enter "." on a separate line to exit insert mode.');
IF (OkANSI OR OkAvatar) THEN
Print('^2 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>^1');
Dec(ThisUser.LineLen,6);
S := '';
WHILE (S <> '.') AND (S <> '.'+#1) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
Prompt(PadRightInt(CurLine,4)+': ');
InLi(S);
IF (S <> '.') AND (S <> '.'+#1) THEN
BEGIN
Abort := NOT NewPtr(Nex);
IF (Abort) THEN
Print('Out of space.')
ELSE
BEGIN
Nex^.S := S;
IF (Top = Cur) THEN
IF (Cur = NIL) THEN
BEGIN
Nex^.Last := NIL;
Nex^.Next := NIL;
Top := Nex;
Bottom := Nex;
END
ELSE
BEGIN
Nex^.Next := Cur;
Cur^.Last := Nex;
Top := Nex;
END
ELSE
BEGIN
IF (Cur = NIL) THEN
BEGIN
Bottom^.Next := Nex;
Nex^.Last := Bottom;
Nex^.Next := NIL;
Bottom := Nex;
END
ELSE
BEGIN
Las := Cur^.Last;
Nex^.Last := Las;
Nex^.Next := Cur;
Cur^.Last := Nex;
Las^.Next := Nex;
END;
END;
Inc(CurLine);
Inc(TotalLines);
END
END;
END;
Inc(ThisUser.LineLen,6);
END;
'L' : BEGIN
Abort := FALSE;
Next := FALSE;
Nex := Cur;
I := CurLine;
WHILE (Nex <> NIL) AND (NOT Abort) AND (NOT HangUp) DO
BEGIN
PLine(I,Nex);
Nex := Nex^.Next;
Inc(I);
END;
END;
'P' : PL;
'R' : IF (Cur <> NIL) THEN
BEGIN
PL;
Prompt(PadRightInt(CurLine,4)+': ');
InLi(S);
Cur^.S := S;
END;
'Q' : Done := TRUE;
'S' : BEGIN
IF (NOT AllRead) THEN
BEGIN
UserColor(5);
Prompt('Not all of file read. ');
AllRead := PYNQ('Save anyway? ',0,FALSE);
END;
IF (AllRead) THEN
BEGIN
Done := TRUE;
Print('Saving ...');
SysOpLog('Saved "'+FSpec+'"');
ReWrite(Fil);
I := 0;
Cur := Top;
WHILE (Cur <> NIL) DO
BEGIN
WriteLn(Fil,Cur^.S);
Cur := Cur^.Next;
Dec(I);
END;
IF (I = 0) THEN
WriteLn(Fil);
Close(Fil);
END;
END;
'T' : BEGIN
Cur := Top;
CurLine := 1;
PL;
END;
END;
UNTIL ((Done) OR (HangUp));
END;
END;
Release(TopHeap);
PrintingFile := FALSE;
LastError := IOResult;
END;
END.