Decimal BASIC is a compiler that generates object Pascal objects, allowing the objects to operate independently.
It defines an object type (Class) called TStatement that corresponds to BASIC statements, and achieves the desired processing by overriding the virtual method execute in its subtypes.
Using BASIC Generic 0.7.5.9 as an example, the internal structure is described in the form of the procedure for adding new commands.
On the Decimal BASIC homepage, go to the BASIC Generic page, download BASIC0759En_Source.zip (or a later version), and unzip it.
Download and install Lazarus （
Start Lazarus, select "Open Project" from the Project menu, and select basic.lpi from the BASIC source folder.
From the Lazarus File menu, load extensio.pas into the source editor.
Make sure
the file ends with:
begin tableInitProcs.accept(statementTableinit); tableInitProcs.accept(FunctionTableInit); end.
The Pascal begin-end statements are executed when the program starts.
tableInitProcs.accept is used to register statements and built-in functions.
statementTableinit is used to register statements, and FunctionTableInit is used to register built-in functions.
The procedure
StatementTableInitImperative('BEEP',BEEPst);
within begin ～ end of statementTableinit
specifies that when 'BEEP' is read, translation will be performed by BEEPst.
The definition of BEEPst is as follows:
function BEEPst(prev,eld:TStatement):TStatement; begin BEEPst:=TBEEP.create(prev,eld) end;
This is a statement that creates a TBEEP type object. The arguments prev and eld of create are used to create a link between statements, but for now, it is enough to understand that this is the way it should be written.
The definition of the object type TBEEP is as follows:
type
TBEEP=class(TStatement)
exp1,exp2:TPrincipal;
constructor create(prev,eld:TStatement);
destructor destroy;override;
procedure exec;override;
end;
TBEEP is a subclass that inherits from the TStatement class.
BEEP statement in Decimal BASIC does not have arguments by default, but in Windows there is also a form that takes two numeric expressions as arguments. The TPrincipal type variables exp1 and exp2 are used to hold the numeric expressions.
TBEEP.create is defined as follows:
constructor TBeep.create;
begin
inherited create(prev,eld);
if (tokenspec<>tail) and (token<>'ELSE') then
begin
exp1:=NExpression;
check(',',IDH_FILE_ENLARGE);
exp2:=NExpression;
end;
end;
In constructor, the constructor from which the object inherits is called first. prev and eld are used there. When constructor is executed, variables in the object are initialized to nil.
There are two types of BEEP statements: one with no arguments and one with two arguments, so processing in constructor is a little complicated. The end of a statement excluding end-of-line comments is determined by tokenspec=tail, but since the BEEP statement is a imperative statement, it can also be written in the part of IF ... THEN ～ ELSE ～. Therefore, to determine whether a statement has not ended, write an if statement like the one shown above (ELSE is a reserved word in Full BASIC). token is a global variable that holds the current token during translation. NExpression is a global function that translates a numeric expression. The results are stored in exp1 and exp2.
A comma is written between the two numeric expressions. check(',',IDH_FILE_ENLARGE) checks whether the comma is written correctly, and if it is correct, it skips the comma, and if not, generates an error according to the information in IDH_FILE_ENLARGE. If the position where IDH_FILE_ENLARGE is written is set to 0, it will not affect normal operation.
The destructor is called when the object is destroyed. Be sure to declare it with override.
The definition of the destructor is as follows:
destructor TBeep.destroy; begin exp1.free; exp2.free; inherited destroy end;
To delete the two variables written in the TBEEP declaration section, exp1.free; and exp2.free; are executed, and then the inherited destructor is executed.
TBEEP.exec is executed when it is this object's turn to execute. Regardless of what the statement is, TStatement.exec is called. In order for TBEEP.exec to be executed correctly at that time, exec is declared in the TBEEP declaration section with override added.
The contents are as follows:
procedure TBEEP.exec;
var
freq,duration:integer;
begin
if exp1=nil then
SysUtils.beep
else
begin
freq:=exp1.evalInteger;
duration:=exp2.evalInteger;
{$IFDEF Windows}
Windows.Beep(freq,duration);
{$ELSE}
SysUtils.beep;
{$ENDIF}
end;
end;
If there are no arguments, SysUtils.beep is simply executed. To determine if there are no arguments, a check is made to see if exp1 is nil. If arguments are written, the values of the two numeric expressions are obtained and Windows.Beep is called. If arguments are written, the values of the two numeric expressions are obtained and Windows.Beep is called. In the Decimal BASIC processing system, the method for evaluating a TPrincipal type variable to obtain an integer value is evalInteger. However, Windows.beep cannot be used in environments other than Windows. In that case, SysUtils.beep is executed, ignoring the values of the two variables.
{$IFDEF ○○○}～{$ELSE}～{$ENDIF} are translation-time switches. If ○○○ is defined during translation, the first ～ will be translated. When running Lazarus in a Windows environment, Windows is defined.
Let's look at the GETKEYSTATE function. The GETKEYSTATE function is a numeric function that takes a single numeric expression as an argument.
{$IFNDEF Darwin}
SuppliedFunctionTableInit('GETKEYSTATE' , GetKeyStatefnc);
{$ENDIF}
{$IFNDEF ○○}～{$ENDIF} instructs that if ○○ is not defined, ～ is translated. Darwin is MAC OS. GETKEYSTATE is invalid in MAC OS, so it is restricted so that it cannot be translated.
This statement instructs that if the token is 'GETKEYSTATE', GetKeyStatefnc is executed.
The definition part of GetKeyStatefnc is as follows:
function GetKeyStatefnc:TPrincipal;
begin
GetKeyStatefnc:=NOperation(TGetKeyState.create)
end;
The function to be registered in SuppliedFunctionTableInit takes a TPrincipal value.
The definition part of GetKeyStatefnc is as follows:
TGetKeyState=class(TMiscInt)
exp:TPrincipal;
constructor create;
function evalLongint:longint;override;
destructor destroy;override;
end;
It has a TPrincipal type variable exp to hold the numeric expression argument. GETKEYSTATE acquires its function behavior by defining a function evalLongint that gives a LongInt value. Functions that determine function values by setting a value with EvalLongint are defined by inheriting the TMiscInt class.
The constructor for TGetKeyState is as follows. checkToken is almost the same as check, but differs in that it semi-forcibly corrects the program if it is incorrect.
constructor TGetKeyState.create;
begin
inherited create;
checkToken('(',IDH_EXTENSION) ;
exp:=NExpression;
checkToken(')',IDH_EXTENSION);
end;The destructor for TGetKeyState looks like this:
destructor TGetKeyState.destroy;
begin
exp.free;
inherited destroy
end; The GetKeyState function is defined as a descendant of TMiscInt. Its actual behavior is determined by defining a virtual method evalLongint that takes a value of type Longint.
function TGetKeyState.evalLongint:longint; begin result:=GetKeyState(exp.evalinteger); end;
The GetKeyState used here is defined in LCLIntf in the Lazarus LCL library. You can use the functions defined in LCLIntf by adding LCLIntf to the uses section of extensio.pas.
Functions that take real values are implemented by declaring them as a subtype of TMiscReal and defining a virtual method evalX that takes an Extended type value.
It is important to note that when using Windows 64-bit or when the CPU is ARM, Extended = double. It may be necessary to use {$IF FPC_HAS_TYPE_EXTENDED} ～ {$ELSE} ～ {$ENDIF} to distinguish between the two cases.
A function that takes a string value can be implemented as a subclass of the TStrExpression class and by overriding the evalS method that takes a string.
Save the following content as newcmd.pas, then in the Lazarus Project menu, select "Add" in the "Project Inspector", select "Add" again, and select newcmd.pas.
You can use a different spelling for the newcmd part, but make sure the unit name and file name match.
After this, make the appropriate edits in the Lazarus IDE and compile.
—――――――――――――――――――(From here)――――――――――――――――――――
unit newcmd;
{$MODE DELPHI}{$H+}
interface
implementation
uses Controls, Dialogs, Forms, SysUtils, lclintf, FileUtil, math,
base, arithmet, texthand, variabl, struct, express, compiler, control,
float, helpctex, textfrm, MainFrm, sconsts, supplied;
{***********************************}
{ Imperative statement, one number and one string parameter }
{***********************************}
type
TNewCommand=class(TStatement)
exp1,exp2:TPrincipal;
constructor create(prev,eld:TStatement);
destructor destroy;override;
procedure exec;override;
end;
constructor TNewCommand.create(prev,eld:TStatement);
begin
inherited create(prev,eld);
exp1:=NExpression;
check(',',0);
exp2:=SExpression;
end;
destructor TNewCommand.destroy;
begin
exp2.free;
exp1.free;
inherited destroy
end;
procedure TNewCommand.exec;
var
x:double;
s:string;
begin
x:=exp1.EvalF;
s:=exp2.EvalS;
//Write the necessary processing hereend
end;
function NewCommandst(prev,eld:TStatement):TStatement;
begin
NewCommandst:=TNewCommand.create(prev,eld);
end;
{********************}
{Numeric function, takes one numeric argument }
{*********************}
type
TNewNFunction=Class(TMiscReal)
exp:TPrincipal;
constructor create;
function evalX:extended;override;
destructor destroy;override;
end;
constructor TNewNFunction.create;
begin
inherited create;
check('(',0);
exp:=NExpression;
check(')',0);
end;
function TNewNFunction.evalX:extended;
var
x, y: extended;
begin
x:=exp.evalX;
//here, find y from x
evalX:=y;
end;
destructor TNewNFunction.destroy;
begin
exp.free;
inherited destroy;
end;
function NewNFunctionfnc:TPrincipal;
begin
NewNFunctionfnc:=NOperation(TNewNFunction.create);
end;
{*********************************}
{string-valued function, arguments are one string and one number}
{**********************************}
type
TNewSFunction=class(TStrExpression)
exp1,exp2:TPrincipal;
constructor create;
function evalS:string;override;
destructor destroy;override;
end;
constructor TNewSFunction.create;
begin
inherited create;
check('(',0);
exp1:=SExpression;
check(',',0);
exp2:=NExpression;
check(')',0);
end;
destructor TNewSFunction.destroy;
begin
exp2.free;
exp1.free;
inherited destroy;
end;
function TNewSFunction.evalS:ansistring;
var
n:longint;
s,t:string;
begin
s:=exp1.evalS;
n:=exp2.evalInteger;
//Find t from s and n
evalS:=s;
end;
function NewSFunctionfnc:TPrincipal;
begin
NewSFunctionfnc:=TNewSFunction.create;
end;
{**********}
{initialize}
{**********}
procedure statementTableinit;
begin
StatementTableInitImperative('NEWCOMMAND', NewCommandst);
end;
procedure FunctionTableInit;
begin
SuppliedFunctionTableInit('NEWFN' , NewNFunctionfnc);
SuppliedFunctionTableInit('NEWF$' , NewSFunctionfnc);
end;
begin
tableInitProcs.accept(statementTableinit);
tableInitProcs.accept(FunctionTableInit);
end.
—―――――――――――――――――――(Fin)―—―――――――――――――――――
Please note that statement names and function names must be 10 characters or less, including the $ at the end of string function names, and alphabetic characters must be registered in uppercase.
When using functions defined in other units, including LCL, add the name of the unit to the uses clause.
You can use external DLLs to create new commands. For example, to use Beep in win32 API, add a line
function Beep(dwFreq:DWORD; dwDuration:DWORD):WINBOOL; stdcall; external 'kernel32' name 'Beep';
Only this line defines a function BEEP. Assign the name of a DLL in external section, and the name in the DLL in the name section. The instructions for external and name (the part enclosed in ' ') distinguish between case and uppercase. The argument type and number, and result type are used to call the DLL function. The argument names have no meaning.
If you call a function in a DLL made for C, substitute cdecl for stdcall.
TBEEP.exec, shown above, can be rewriten as folows.
{$IFDEF Windows}
function Beep(dwFreq:DWORD; dwDuration:DWORD):WINBOOL; stdcall; external 'kernel32' name 'Beep';
{$ENDIF}
procedure TBEEP.exec;
var
freq,duration:integer;
begin
if exp1=nil then
SysUtils.beep
else
begin
freq:=exp1.evalInteger;
duration:=exp2.evalInteger;
{$IFDEF Windows}
Beep(freq,duration);
{$ELSE}
SysUtils.beep;
{$ENDIF}
end;
end;
Note that the program will not start in an environment where the specified DLL does not exist.
And note in Decimal BASIC Ver.8, Ver.0.9, BASIC Accelerator, and Paract BASIC, the GUI cannot be executed in the execution thread.
In BASIC Accelerator and Paract BASIC, Pascal statements are generated by overriding the virtual method "code", which has an ansistring type value, for both statements and functions. The code method of the components can be used.
See statemen.pas and supplied.pas for examples.
You can also use procedures and functions in your own libraries in the Pascal code you generate. In that case, you must add them (the units used at run time) to the UsesBlock in TProcTbl.Code in struct.pas. In the test phase, you can modify and run BASICunit.pas, which can be obtained by selecting Code from the Run menu. Note that in the units used at run time, procedures and functions referenced from outside must be declared in the interface section.