Category : Miscellaneous Language Source Code
Archive   : SPL.ZIP
Filename : PREDITOR.SP

 
Output of file : PREDITOR.SP contained in archive : SPL.ZIP
BEGIN
{ Preditor : Program editor }

{ This program is written in The Structured Programming Language.
You need to obtain the Structured Programming Language processor
and process this program with it. A BASIC program will result and
you will need to sort the program using SORT.EXE and then compile
the program using any BASIC compiler. This program will run on
MSDOS, PCDOS, or where there is compiled BASIC, such as on AMIGA,
MACINTOSH, ATARI ST. You first must translate the program on MSDOS
or PCDOS. You can obtain the Structured Programming Language from
PC SIG at 800 245 6717, ask for DISK 666.
Softdisk at 800 831 2694, ask for BIG BLUE DISK issue #16.
Public Brand Software at 800 426 3475, ask for DISK BA-9.
You can also get file SPLLIB.ARC from bbs systems at 800 632 7227,
516 561 6590, and 516 334 8221. SPL is also known as file SPL.ARC
and can be gotten from bbs systems at 800 365 6262 and 800 323 7464.
This program PREDITOR and The Structured Programming Language are
both shareware. Certainly if you use the SPL processor to create
a running program out of PREDITOR, then you should register both
The SPL processor and this program, PREDITOR if you use them and
like them. If you have questions, call me, Dennis Baer at work at
516 694 5872. }

INTEGER Found, { Sucessful find }
I,J, { Counters }
Character_pointer, { Character pointer }
Result, { Result }
File_open, { File open }
Current_line, { Current line in file }
Output_mode, { Output mode }
LE; { Logical end of file }

STRING L, { File record }
Change_delimiter, { Delimiter used in the change command. }
Ifile; { Input file name. }

INTEGER ARRAY PT(4000); { Record pointers }

STRING ARRAY OF(4000); { File records }

PROCEDURE INITIALIZE; { Initialize file arrays, output messages. }
BEGIN
OUTPUT('*** PREDITOR version 1.0 ***');
OUTPUT(' (c) Dennis Baer 1988');
OPEN('LPT1:' FOR OUTPUT AS #7); { Open printer }
File_open := 0; { File open set to zero, file not open }
Change_delimiter := '!'; { Set default change delimiter }
FOR I := 1 STEP 1 UNTIL 4000 DO
BEGIN
PT(I) := 0; { Set pointer to record as null }
OF(I) := ''; { Set record null }
END
END

Š INTEGER LOW,HIGH,Low_line,High_line; { Line number variables }

PROCEDURE OUTSCREEN(LOW,HIGH);
BEGIN
IF HIGH=0 THEN
BEGIN
OUTPUT('<' @ LOW @ '>' @ OF(PT(LOW)));
Current_line := LOW;
RETURN;
END
FOR I:= LOW STEP 1 UNTIL HIGH DO
BEGIN
OUTPUT('<' @ I @ '>' @ OF(PT(I)));
END
Current_line := HIGH;
END

PROCEDURE OUTPRINTER(LOW,HIGH);
BEGIN
FOR I:= LOW STEP 1 UNTIL HIGH DO
BEGIN
L := OF(PT(I));
OUTPUT(#7, MID$(L,1,80));
IF LEN(L) > 80 THEN
BEGIN
L := MID$(L,81); OUTPUT(#7,L);
END
END
Current_line := HIGH; OUTPUT();
END

STRING Search_string, Replace_string;

PROCEDURE FIND(Search_string);
BEGIN
Found := 0;
FOR J := Current_line STEP 1 UNTIL LE DO
BEGIN
Character_pointer := INSTR( OF(PT(J)), Search_string );
IF Character_pointer <> 0 THEN
BEGIN
Current_line := J;
Found := 1; RETURN;
END
END
Current_line := 1;
END

PROCEDURE CHANGE(Search_string,Replace_string);
BEGIN
STRING Part_1, Part_2, Part_3;

Found := 0;
Character_pointer := INSTR( OF(PT(Current_line)), Search_string );
IF Character_pointer = 0 THEN RETURN;
Š IF Character_pointer = 1 THEN
BEGIN
Part_1 := '';
END

ELSE
BEGIN
Part_1 := LEFT$( OF(PT(Current_line)), Character_pointer-1 );
END

IF ( Character_pointer - 1 + LEN(Search_string) ) >
LEN(OF(PT(Current_line))) THEN
BEGIN
Part_3 := '';
Part_2 := Replace_string;
OF(PT(Current_line)) := Part_1 + Part_2 + Part_3;
Found := 1;
OUTSCREEN(Current_line,0);
RETURN;
END

ELSE
BEGIN
Part_3 := MID$( OF(PT(Current_line)), Character_pointer +
LEN(Search_string) );
Part_2 := Replace_string;
OF(PT(Current_line)) := Part_1 + Part_2 + Part_3;
Found := 1;
OUTSCREEN(Current_line,0);
RETURN;
END
END

PROCEDURE DELETE_LINES(LOW,HIGH);
BEGIN
INTEGER Temp;

Temp := LOW;
IF HIGH = 0 THEN HIGH := LOW;
FOR J := LOW STEP 1 UNTIL HIGH DO
BEGIN
OF(PT(J)) := ''; PT(J) := 0;
END
IF HIGH < LE THEN
BEGIN
FOR J := HIGH + 1 STEP 1 UNTIL LE DO
BEGIN
PT(Temp) := PT(J);
PT(J) := 0;
Temp := Temp + 1;
END
END
Current_line := 1; LE := LE - (HIGH-LOW+1);
END

Š STRING Line;

PROCEDURE INPUTLINE(Line);
BEGIN
INTEGER Temp;

FOR I := 1 STEP 1 UNTIL 4000 DO
BEGIN
IF OF(I) = '' THEN
BEGIN
Temp := I;
GO TO Found_blank;
END
END
Found := 0;
RETURN;

Found_blank:

Found := 1;
IF PT(1) = 0 THEN
BEGIN
Current_line := 1; LE := 1; PT(1) := Temp;
OF(PT(1)) := Line; RETURN;
END

FOR I := LE + 1 STEP -1 UNTIL Current_line + 2 DO
BEGIN
IF LE = Current_line THEN GO TO Done_shifting;
PT(I) := PT(I-1);
END

Done_shifting:

PT(Current_line + 1) := Temp; LE := LE + 1;
OF(PT(Current_line + 1)) := Line;
Current_line := Current_line + 1;
END

STRING File; { File name of open file. }

PROCEDURE OPENFILE(File);
BEGIN
INTEGER Temp;

IF File_open = 1 THEN
BEGIN
Result := 0;
RETURN;
END

ONERRGOTO File_open_error;

OPEN( File FOR INPUT AS #1 );

Š ONERRGOTO File_read_error;

FOR I := 1 STEP 1 UNTIL 4000 DO
BEGIN
IF EOF(1) THEN GO TO Success; { End of file. }
LINEIN( #1,L); { Read record. }
IF L = '' THEN L := ' '; { Null line set to a blank }
PT(I) := I; OF(I) := L; Temp := I;
END

Success: CLOSE(#1); Result := 1; File_open := 1; { Set file open. }
LE := Temp; Current_line := 1;
RETURN;

File_open_error: Result := 0; OUTPUT('*** Error, opening file: ' @ File @
' ***');
RESUME Finish_open;

File_read_error: Result := 0; OUTPUT('*** Error, reading file: ' @ File @
' ***');
RESUME Finish_open;

Finish_open:

END

PROCEDURE SAVEFILE(File); { Save text file. }
BEGIN
{ If file is not open and no file name is given
give error code and return. }

Result := 1; { Assume result is 1, error will change result. }

IF File_open AND File = '' THEN
BEGIN
Result := 0; RETURN;
END

IF LE = 0 THEN
BEGIN
OUTPUT('File: ' @ File @ ' is empty. ');
Result := 0; RETURN;
END

IF File_open = 0 THEN
BEGIN
File_open := 1;
OPEN(File FOR OUTPUT AS #1);
END

ELSE
BEGIN
OPEN(File FOR OUTPUT AS #1);
END

Š FOR I := 1 STEP 1 UNTIL LE DO
BEGIN
OUTPUT(#1,OF(PT(I)));
END
CLOSE(#1);
END

PROCEDURE CLOSEFILE(File); { Close text file. }
BEGIN
IF File_open = 0 THEN
BEGIN
Result := 0; RETURN; { Error, no file is open. }
END
SAVEFILE(File); File := ''; { Save the file. }
IF Result = 0 THEN RETURN; { Error occurred. }
File_open := 0; { File closed, no file open, once again. }

FOR I := 1 STEP 1 UNTIL 4000 DO
BEGIN
PT(I) := 0; { Nullify pointer to line. }
OF(I) := ''; { Set line null. }
END
LE := 0; { Set logical end to zero, empty file buffer. }
END

PROCEDURE REGISTER;
BEGIN
OUTPUT();
OUTPUT(
'*****************************************************************');
OUTPUT(
'* This program PREDITOR has been developed by Dennis Baer. *');
OUTPUT(
'* If you use this program and you like it then make a pledge *');
OUTPUT(
'* of $25. Send a post card with your name and address on the *');
OUTPUT(
'* front and my name and address on the back and write $25 as *');
OUTPUT(
'* your pledge, also on back. Place this post card in a *');
OUTPUT(
'* business envelope and mail it to: *');
OUTPUT(
'* *');
OUTPUT(
'* Dennis Baer *');
OUTPUT(
'* 25 Miller Road *');
OUTPUT(
'* Farmingdale,New York 11735 *');
OUTPUT(
'* *');
OUTPUT(
'* When you receive your post card back, HONOR your pledge and *');
OUTPUT(
Š '* make check out for $25 to Dennis Baer. THANK YOU. *');
OUTPUT(
'* Registered users are entitled to software support. *');
OUTPUT(
'* Call 516 694 5872 *');
OUTPUT(
'*****************************************************************');
END


{ Main program }

INITIALIZE;

REGISTER;

Ask:

OUTPUT();
OUTPUT('Edit'); OUTPUT('>' @);
LINEIN(Line); { Get an input line }

Remove_space:

IF Line = ' ' OR Line = '' THEN
BEGIN
OUTPUT('Error, invalid Edit command '); GO Ask;
END

IF LEFT$(Line,1) = ' ' THEN { Remove extra spaces from the left }
BEGIN
Line := RIGHT$(Line,LEN(Line)-1); GO Remove_space;
END

{ *************************** STOP COMMAND ********************************** }


IF Line = 'STOP' OR Line = 'stop' THEN
BEGIN
CLOSE();
REGISTER;
STOP;
END

{ *************************** SAVE FILE COMMAND ***************************** }


IF LEFT$(Line,1) = 'S' OR LEFT$(Line,1) = 's' THEN { Save file }
BEGIN
IF MID$(Line,2,1) <> ' ' THEN
BEGIN
OUTPUT('Error, missing space'); GO Ask;
END
IF LEN(Line) <= 2 THEN
BEGIN
Š Blank:

OUTPUT('No file name entered.'); GO Ask;
END

Ifile := RIGHT$(Line,LEN(Line)-2);
Result := 1; { Assume successful result beforehand }

SAVEFILE(Ifile); { Save file buffer to disk }

IF Result = 0 THEN
BEGIN
OUTPUT('Failure to save file ' @ Ifile); GO Ask;
END
GO Ask;
END

{ *************************** CLOSE FILE COMMAND **************************** }

IF LEFT$(Line,2) = 'CL' OR LEFT$(Line,2) = 'cl' THEN
BEGIN
Result := 1; { Assume successful result at first }
CLOSEFILE(Ifile);
IF Result = 0 THEN
BEGIN
OUTPUT('Failure to close file ' @ Ifile); GO Ask;
END
GO Ask;
END

{ *************************** OPEN FILE COMMAND ***************************** }

IF LEFT$(Line,3) = 'OP ' OR LEFT$(Line,3) = 'op ' THEN
BEGIN
IF File_open = 1 THEN
BEGIN
OUTPUT('File ' @ Ifile @ ' is already open, error.');
GO Ask;
END
Ifile := RIGHT$(Line,LEN(Line)-2);
IF LEN(Line)<=3 THEN
BEGIN
OUTPUT('No file name entered, error.');
GO Ask;
END
Result := 1; { Assume result is 1 }
OPENFILE(Ifile);
IF Result = 0 THEN
BEGIN
OUTPUT('Failure to open file ' @ Ifile);
GO Ask;
END
GO Ask;
END

Š{ *************************** LIST COMMAND ********************************** }

IF LEFT$(Line,1) = 'L' OR LEFT$(Line,1) = 'l' THEN
BEGIN
Output_mode := 0; { Set output mode to list }
IF Line = 'L' OR Line = 'L ' OR Line = 'l' OR Line = 'l ' THEN
BEGIN
Low_line := Current_line; High_line := Current_line;
GO Check_and_print;
END

The_rest:

IF MID$(Line,2,1) <> ' ' THEN
BEGIN
OUTPUT('Missing space'); GO Ask;
END
Line := RIGHT$(Line,LEN(Line)-2);
Low_line := VAL(Line);
IF Low_line <= 0 THEN
BEGIN
OUTPUT('Invalid low line number'); GO Ask;
END
Character_pointer := INSTR(Line,',');
IF Character_pointer = 0 THEN
BEGIN
High_line := Low_line;
GO Check_and_print;
END
IF Character_pointer = LEN(Line) THEN
BEGIN
OUTPUT('No high line number entered');
GO Ask;
END
Line := MID$(Line,Character_pointer+1);
IF Line = '*' THEN
BEGIN
High_line := LE;
GO Check_and_print;
END
High_line := VAL(Line);

IF High_line <=0 THEN
BEGIN
OUTPUT('Invalid high line number');
GO Ask;
END

Check_and_print:

IF Low_line > LE OR
Low_line < 1 OR
High_line > LE OR
High_line < 1 THEN
BEGIN
OUTPUT('Line number out of bounds');
Š GO Ask;
END
IF Low_line > High_line THEN
BEGIN
OUTPUT('First line number higher than second line number');
GO Ask;
END

IF Output_mode = 1 THEN
BEGIN
OUTPRINTER(Low_line,High_line); GO Ask;
END

IF Output_mode = 0 THEN
BEGIN
OUTSCREEN(Low_line,High_line); GO Ask;
END

IF Output_mode = 2 THEN
BEGIN
DELETE_LINES(Low_line,High_line); GO Ask;
END
END

{ *************************** TOP COMMAND *********************************** }

IF Line = 'T' OR Line = 't' THEN
BEGIN
Current_line := 1;
OUTPUT('Top');
GO Ask;
END

{ *************************** PRINT COMMAND ********************************* }

IF LEFT$(Line,1) = 'P' OR LEFT$(Line,1) ='p' THEN
BEGIN
Output_mode := 1;
IF Line = 'P' OR Line = 'P ' OR Line = 'p' OR Line = 'p ' THEN
BEGIN
High_line := Current_line;
Low_line := Current_line;
GO Check_and_print;
END

ELSE GO TO The_rest;
END

{ *************************** DELETE COMMAND ******************************** }

IF LEFT$(Line,1) = 'D' OR LEFT$(Line,1) = 'd' THEN
BEGIN
Output_mode := 2; { delete is mode 2 }
IF Line = 'D' OR Line ='D ' OR Line = 'd' OR Line = 'd ' THEN
BEGIN
Š Low_line := Current_line;
High_line := Current_line;
GO Check_and_print;
END

ELSE GO TO The_rest;
END

{ *************************** CHANGE COMMAND ******************************** }

IF LEFT$(Line,1) = 'C' OR LEFT$(Line,1) = 'c' THEN
BEGIN
STRING Search, { Contains search string }
Replace; { Contains replacement string }

Line := MID$(Line,2);

Strip_blank:

IF LEFT$(Line,1) = ' ' THEN
BEGIN
Line := MID$(Line,2);
GO Strip_blank;
END
IF LEFT$(Line,1) <> Change_delimiter THEN
BEGIN
OUTPUT('Missing ' @ Change_delimiter);
GO Ask;
END
Search := ''; Line := MID$(Line,2);
IF LEN(Line) = 0 THEN
BEGIN
OUTPUT('Error, search string is null'); GO Ask;
END
IF MID$(Line,1,1) = Change_delimiter THEN
BEGIN
OUTPUT('Error, no string entered for search');
GO Ask;
END

Build:

Search := Search + MID$(Line,1,1); Line := MID$(Line,2);
IF Line = '' THEN
BEGIN
OUTPUT('Missing ' @ Change_delimiter);
GO Ask;
END
IF LEFT$(Line,1) <> Change_delimiter THEN GO Build;
Replace := MID$(Line,2); { Get replacement string }
CHANGE(Search,Replace);
IF Found = 0 THEN
BEGIN
OUTPUT('String:' @ Search @ ' not found');
GO Ask;
Š END
GO Ask;
END

{ *************************** FIND COMMAND ********************************** }

IF LEFT$(Line,1) = 'F' OR LEFT$(Line,1) = 'f' THEN
BEGIN
STRING Search; { String to search for }

IF Line = 'F' OR Line = 'F ' OR Line = 'f' OR Line = 'f ' THEN
BEGIN
OUTPUT('Missing search string');
GO Ask;
END

Line := MID$(Line,2);

Strip:

IF LEFT$(Line,1) = ' ' THEN
BEGIN
Line :=MID$(Line,2);
GO Strip;
END

IF MID$(Line,1,1) <> Change_delimiter THEN
BEGIN
OUTPUT('Missing ' @ Change_delimiter);
GO Ask;
END
Search := ''; Line := MID$(Line,2);
IF LEN(Line) = 0 THEN
BEGIN
OUTPUT('Missing string to be found');
GO Ask;
END
IF MID$(Line,1,1) = Change_delimiter THEN
BEGIN
OUTPUT('Error, null search string');
GO Ask;
END

Build_1:

Search := Search + MID$(Line,1,1); Line := MID$(Line,2);
IF Line = '' THEN
BEGIN
OUTPUT('Missing ' @ Change_delimiter);
GO Ask;
END
IF LEFT$(Line,1) <> Change_delimiter THEN GO Build_1;
FIND(Search);
IF Found := 0 THEN
BEGIN
Š OUTPUT('String: ' @ Search @ ' not found');
Current_line := 1;
GO Ask;
END
GO Ask;
END

{ *************************** BOTTOM COMMAND ******************************** }

IF Line = 'B' OR Line = 'b' THEN
BEGIN
Current_line := LE;
OUTPUT('Bottom at line: ' @ Current_line);
GO Ask;
END

{ *************************** INPUT COMMAND ********************************* }

IF Line = 'I' OR Line = 'i' THEN
BEGIN
OUTPUT('Input'); OUTPUT('>' @);
Line := '';

Inline:

LINEIN(Line);
IF Line = '' THEN GO Ask;
INPUTLINE(Line);
IF Found = 1 THEN
BEGIN
OUTPUT('>' @);
GO Inline;
END
OUTPUT('Input stopped, input buffer is full');
GO Ask;
END

OUTPUT('Invalid Edit command:' @ Line); GO Ask;

{ End of program }

END



  3 Responses to “Category : Miscellaneous Language Source Code
Archive   : SPL.ZIP
Filename : PREDITOR.SP

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/