home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
s
/
scrmgr.zip
/
SCRPRIM.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-11-04
|
11KB
|
419 lines
{$A+,F+,R-,S-,V-,X+}
{***************************************************}
{* SCRPRIM.PAS 1.00 *}
{* Primitives for Script management *}
{* Steve Sneed, TurboPower Software 1992 *}
{* Released to the public domain *}
{* Requires TP6 & Object Professional to compile *}
{***************************************************}
(*
This unit implements a simple script language manager. Based on the script
parser in OzCIS, it is built on the "one statement per line" principle,
similar to the DOS batch language. It's overall design allows much more
complex script parsers to be developed, however.
In a nutshell: the entire script file is loaded into a DoubleList object.
Script execution starts at the head of the list by retrieving the first
active line and parsing it, and repeating the process as needed. Labels
are declared as in the DOS batch language, a word or phrase (no spaces) that
starts with a colon (:), on a line by itself. The JUMP (GOTO) command scans
the list looking for the appropriate label, and when found, resets CurP to
that line and continues.
GOSUB works differently: each node of the list contains a byte variable
(Level) that is initialized to 0. The list object itself also has a byte
field (CurLevel) that is initialized to 0. When a GOSUB command is
encountered, CurLevel is incremented and the GOSUB command line's Level
variable is set to CurLevel, and the list is searched for the GOSUB label
using the same logic as GOTO. When a RETURN command is encountered, the
list is scanned for a node with a Level value = CurLevel; if found, CurP is
set to that node, the node's Level variable is reset to 0 and CurLevel is
decremented. This scheme allows up to 255 nested levels of GOSUB and an
unlimited number of GOSUBs within one script.
With this engine, one important virtual method must be overridden: the
ProcessLine function. The script manager gets each line of the script in
turn and calls ProcessLine, passing the line in question. ProcessLine's
job is to do whatever the line commands in your script language, returning
True if successful or False if the script should abort. Under this system
your language can be a very simplistic, one-statement-per-line scheme or a
more complex token-based language; what and how the parser does it's actual
work is up to you.
*)
unit ScrPrim; {primitives for script file management}
interface
uses
DOS,
OpInline,
OpDos,
OpRoot,
OpString;
const
{command constants}
scGoTo = 997;
scGoSub = 998;
scReturn = 999;
const
CommentChar = ';';
type
{one line of a script}
PStr = ^String;
PLine = ^SLine;
SLine =
object(DoubleListNode)
LP : PStr;
Level : Byte;
constructor Init(S : String);
destructor Done; virtual;
end;
{our script manager}
ScriptPtr = ^ScriptMgr;
ScriptMgr =
object(DoubleList)
CurP : PLine;
CurLevel : Byte;
Running : Boolean;
{...initialization and virtual methods}
constructor Init;
{-instantiate our script manager object}
destructor Done; virtual;
{-dispose of object when done}
function ProcessLine(S : String) : Boolean; virtual;
{-process a line of the script. *MUST BE OVERRIDDEN*}
procedure Process; virtual;
{-run the script}
procedure PrepareLine(var S : String); virtual;
{-allows pre-processing a line before adding it to the list}
{...other public methods}
function LoadScript(FN : PathStr) : Boolean;
{-load a script file into the manager}
function LoadSubScript(FN : PathStr) : Boolean;
{-load a secondary script and GOSUB to it}
function Jump(S : PathStr) : Boolean;
{-jump (GOTO) to label S}
function GoSub(S : PathStr) : Boolean;
{-jump to a label with provision for returning later}
function Return : Boolean;
{-return from a GOSUB}
{...private methods}
procedure NextActive;
function FindLabel(S : PathStr) : PLine;
end;
implementation
procedure CleanCmts(var S : String);
{-removes trailing comments from a line}
var
B : Byte;
begin
B := Length(S);
while B > 0 do begin
{exit if we've received a quote char}
if (S[b] = '"') or (S[b] = #39) then
exit;
{if we've found the comment marker, remove the rest of the line and go}
if (S[b] = CommentChar) then begin
S[0] := Chr(B-1);
S := Trim(S);
exit;
end;
Dec(B);
end;
end;
{--- Script line node methods ---}
constructor SLine.Init(S : String);
begin
if not DoubleListNode.Init then Fail;
LP := PStr(StringToHeap(S));
if LP = nil then Fail;
end;
destructor SLine.Done;
begin
DisposeString(Pointer(LP));
end;
{--- ScriptMgr methods ---}
constructor ScriptMgr.Init;
begin
if not DoubleList.Init then Fail;
{init our internal vars}
CurLevel := 0;
CurP := nil;
Running := False;
end;
destructor ScriptMgr.Done;
begin
DoubleList.Done;
end;
function ScriptMgr.ProcessLine(S : String) : Boolean;
{-method to actually process the script line. Returns false to abort script.}
{ *MUST BE OVERRIDDEN*}
begin
RunError(211);
end;
procedure ScriptMgr.PrepareLine(var S : String);
{-perform pre-processing on line before adding it to the list. Allows}
{ comments removal, etc.}
begin
S := Trim(S);
CleanCmts(S);
end;
function ScriptMgr.LoadScript(FN : PathStr) : Boolean;
{-load a script into our manager. Returns false on error}
label
Breakout;
var
F : Text;
S : String;
P : PLine;
begin
{assume failure}
LoadScript := False;
Assign(F, FN);
Reset(F);
if IOResult <> 0 then exit;
{create a dummy label to start the script}
New(P, Init(':HEAD_OF_SCRIPT'));
if P = nil then goto Breakout;
Append(P);
{read in the file}
while not EOF(F) do begin
ReadLn(F, S);
if IOResult <> 0 then goto Breakout;
{pre-process line}
PrepareLine(S);
{make sure it's a valid line}
if (S <> '') then begin
{if this is a label line, upcase it for later}
if S[1] = ':' then
S := StUpcase(S);
{add it to the list}
New(P, Init(S));
if P = nil then goto Breakout;
Append(P);
end;
end;
{script loaded, initialize the current-line pointer}
CurP := Pline(Head);
LoadScript := True;
Breakout:
Close(F);
if IOResult = 0 then ;
end;
function ScriptMgr.LoadSubScript(FN : PathStr) : Boolean;
{-Loads a secondary script onto the end of the first and GOSUBS to it}
label
Breakout;
var
F : Text;
S : String;
P, Q : PLine;
begin
LoadSubScript := False;
{if we're maxed on GOSUB levels, fail}
if CurLevel = 255 then exit;
{generate a label using the file's name}
S := JustFileName(FN);
S := StUpCase(S);
S := ':' + S;
{see if said label is already in file...}
P := FindLabel(S);
if P <> nil then begin
{this secondary script is already loaded, just jump to it}
Inc(CurLevel);
CurP^.Level := CurLevel;
CurP := P;
LoadSubScript := True;
exit;
end;
Assign(F, FN);
Reset(F);
if IOResult <> 0 then exit;
{add the new label to the list}
New(P, Init(S));
if P = nil then goto Breakout;
Append(P);
{load the rest of the script}
while not EOF(F) do begin
ReadLn(F, S);
if IOResult <> 0 then goto Breakout;
{pre-process line}
PrepareLine(S);
if (S <> '') then begin
{if a label, upcase for later}
if S[1] = ':' then
S := StUpcase(S);
{add to the list}
New(Q, Init(S));
if Q = nil then goto Breakout;
Append(Q);
end;
end;
{load was successful, GOSUB to the new script}
Inc(CurLevel);
CurP^.Level := CurLevel;
CurP := P;
LoadSubScript := True;
Breakout:
Close(F);
if IOResult = 0 then ;
end;
procedure ScriptMgr.NextActive;
{-sets CurP to the next non-label line in the script}
begin
CurP := PLine(Next(CurP));
{skip label lines}
while (CurP <> nil) and (CurP^.LP^[1] = ':') do
CurP := PLine(Next(CurP));
end;
function ScriptMgr.FindLabel(S : PathStr) : PLine;
{-find the requested label; return line pointer or nil if not found}
var
P : PLine;
begin
FindLabel := nil;
{make sure passed label is in proper format}
S := StUpcase(S);
if S[1] <> ':' then
S := ':' + S;
{scan the list looking for our matching label}
P := PLine(Head);
while P <> nil do begin
if P^.LP^ = S then begin
{found it!}
FindLabel := P;
exit;
end;
P := PLine(Next(P));
end;
end;
function ScriptMgr.Jump(S : PathStr) : Boolean;
{-jump (GOTO) to label S}
var
P : PLine;
begin
Jump := False;
P := FindLabel(S);
if P <> nil then begin
{found it, set our vars}
Jump := True;
CurP := P;
end;
end;
function ScriptMgr.GoSub(S : PathStr) : Boolean;
var
P : PLine;
begin
GoSub := False;
{make sure we have a return marker}
if CurLevel = 255 then exit;
P := FindLabel(S);
if P <> nil then begin
{found it, set our vars}
Inc(CurLevel);
CurP^.Level := CurLevel;
CurP := P;
GoSub := True;
end;
end;
function ScriptMgr.Return : Boolean;
{-return from a GOSUB}
var
P : PLine;
begin
Return := False;
{make sure we've got somewhere to return to}
if CurLevel = 0 then exit;
{look for our return point}
P := PLine(Head);
while P <> nil do begin
if P^.Level = CurLevel then begin
{found it; clean up nessessary vars and exit}
Dec(CurLevel);
P^.Level := 0;
CurP := P;
Return := True;
exit;
end;
P := PLine(Next(P));
end;
end;
procedure ScriptMgr.Process;
{-run the script}
begin
{set flag noting script is now running}
Running := True;
while CurP <> nil do begin
{get the next active line}
NextActive;
if CurP <> nil then
{process it}
if not ProcessLine(CurP^.LP^) then
CurP := nil;
end;
Running := False;
end;
end.